#!perl -T # -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/02-*.t" -*- BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile use Test::More tests => 1 + 6*5 + 3; use strict; use warnings; BEGIN { use_ok( 'Test::Trap' ); } # Inner and outer traps with different leaveby and context: my $x = trap { trap { exit }; die unless $trap->leaveby eq 'exit'; $trap; }; # outer trap is( $trap->leaveby, 'return', 'Expecting to return' ); ok( !$trap->list, 'Not list context' ); ok( $trap->scalar, 'Scalar context' ); ok( !$trap->void, 'Not void context' ); is_deeply( $trap->return, [$x], 'Returned the trapped() object' ); # inner trap is( $x->leaveby, 'exit', 'Inner: Exited' ); ok( !$x->list, 'Inner: Not list context' ); ok( !$x->scalar, 'Inner: Not scalar context' ); ok( $x->void, 'Inner: Void context' ); is_deeply( $x->return, undef, 'Inner: "Returned" ()' ); # An inner trap localizes $trap, then successfully calls a twice-inner # trap. After successful exit from the once-inner trap, $trap reverts # to its previous value: trap { trap { exit }; is( $trap->leaveby, 'exit', 'Expecting to exit' ); ok( !$trap->list, 'Not list context' ); ok( !$trap->scalar, 'Not scalar context' ); ok( $trap->void, 'Void context' ); is_deeply( $trap->return, undef, 'No return' ); { local $trap; trap { die }; # If the trap / local $trap breaks again, these method calls will # raise an exception, which we might as well catch: is( eval { $trap->leaveby }, 'die', 'Expecting to die' ); ok( eval { !$trap->list }, 'Not list context' ); ok( eval { !$trap->scalar }, 'Not scalar context' ); ok( eval { $trap->void }, 'Void context' ); is_deeply( eval { $trap->return }, undef, 'No return' ); } is( $trap->leaveby, 'exit', 'Revert: Expecting to exit' ); ok( !$trap->list, 'Revert: Not list context' ); ok( !$trap->scalar, 'Revert: Not scalar context' ); ok( $trap->void, 'Revert: Void context' ); is_deeply( $trap->return, undef, 'No return' ); }; is( $trap->leaveby, 'return', 'Expecting to return' ); ok( !$trap->list, 'Not list context' ); ok( !$trap->scalar, 'Not scalar context' ); ok( $trap->void, 'Void context' ); is_deeply( $trap->return, [], 'Void return' ); # exit compiled to CORE::GLOBAL::exit, which is undefined at runtime ... my $flag; trap { local *CORE::GLOBAL::exit; trap { exit }; is( $trap->leaveby, 'exit', 'Expecting to have exited' ); exit; # should die! $flag = 1; END { ok( !$flag, 'Code past (dying) exit should compile, but not run' ) } }; like( $trap->die, qr/^Undefined subroutine &CORE::GLOBAL::exit called at /, 'Dies: Undefined exit()' );