Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re: How to test exit? - override CORE::GLOBAL::exit

by imp (Priest)
on Jun 05, 2007 at 19:46 UTC ( #619490=note: print w/ replies, xml ) Need Help??


in reply to How to test exit?

You could override the core exit function with a thin wrapper that executes a callback with the logic you want to test. Something like this:

use strict; use warnings; use Test::More (tests => 1); my $exit_callback = sub {}; BEGIN { *CORE::GLOBAL::exit = sub { $exit_callback->(@_) }; } my $exit_called = 0; $exit_callback = sub { $exit_called = 1}; exit; is($exit_called, 1, "exit was called");
Or you could play with it a bit more and do something like this:
use strict; use warnings; use Test::More (tests => 2); my $exit_callback = sub {}; BEGIN { *CORE::GLOBAL::exit = sub { $exit_callback->(@_) }; } sub exit_ok(&$) { my ($code, $message) = @_; my $exit_called = 0; $exit_callback = sub { $exit_called = 1}; $code->(); is($exit_called, 1, $message); } sub noexit_ok(&$) { my ($code, $message) = @_; my $exit_called = 0; $exit_callback = sub { $exit_called = 1}; $code->(); is($exit_called, 0, $message); } exit_ok { exit } "exit called"; noexit_ok { } "exit not called";


Comment on Re: How to test exit? - override CORE::GLOBAL::exit
Select or Download Code
Replies are listed 'Best First'.
Re^2: How to test exit? - wrote a quick Test::Exit module
by imp (Priest) on Jun 05, 2007 at 20:16 UTC
    I decided to play with this a little more and wrote a quick implementation of Test::Exit.

    Update - use Sidhekin 's Test::Trap instead

    Test/Exit.pm

    package Test::Exit; use strict; use warnings; use Test::Builder; use base qw( Exporter ); our @EXPORT = qw( exit_ok exit_nok exit_with ); my $test = Test::Builder->new; my $exit_callback = sub {}; BEGIN { *CORE::GLOBAL::exit = sub { $exit_callback->(@_) }; } sub exit_with(&$$) { my ($coderef, $expected_exit_code, $message) = @_; my $exit_called = 0; my $exit_code = 0; $exit_callback = sub { $exit_called = 1; $exit_code = shift }; $coderef->(); if ($exit_called) { if (! $test->ok( $expected_exit_code == $exit_code, $message)) + { $test->diag("expected $expected_exit_code but received $ex +it_code"); } } else { fail($message . " - exit not called"); } } sub exit_ok(&$) { my ($coderef, $message) = @_; my $exit_called = 0; $exit_callback = sub { $exit_called = 1}; $coderef->(); $test->ok($exit_called == 1, $message); } sub exit_nok(&$) { my ($coderef, $message) = @_; my $exit_called = 0; $exit_callback = sub { $exit_called = 1}; $coderef->(); $test->ok($exit_called == 0, $message); } 1; =head1 NAME Test::Exit - Tests whether exit was called =head2 exit_ok exit_ok { exit; }, 'assert that exit was called'; =head2 exit_nok exit_nok { }, 'assert that exit was not called'; =head2 exit_with exit_with { exit 2 }, 2, 'expect exit(2)'; =cut
    test.pl
    use strict; use warnings; use Test::More (tests => 3); use Test::Exit; exit_ok { exit } "exit called"; exit_nok { } "exit not called"; exit_with { exit 2; } 2, 'exit code = 2';
      You can use Test::Trap , to catch exitcode, stdout, stderr etc of a subroutine

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://619490]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (7)
As of 2015-07-30 05:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (270 votes), past polls