1#!perl -T 2# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/02-*.t" -*- 3 4BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile 5use Test::More tests => 1 + 6*5 + 3; 6use strict; 7use warnings; 8 9BEGIN { 10 use_ok( 'Test::Trap' ); 11} 12 13# Inner and outer traps with different leaveby and context: 14my $x = trap { 15 trap { exit }; 16 die unless $trap->leaveby eq 'exit'; 17 $trap; 18}; 19# outer trap 20is( $trap->leaveby, 'return', 'Expecting to return' ); 21ok( !$trap->list, 'Not list context' ); 22ok( $trap->scalar, 'Scalar context' ); 23ok( !$trap->void, 'Not void context' ); 24is_deeply( $trap->return, [$x], 'Returned the trapped() object' ); 25# inner trap 26is( $x->leaveby, 'exit', 'Inner: Exited' ); 27ok( !$x->list, 'Inner: Not list context' ); 28ok( !$x->scalar, 'Inner: Not scalar context' ); 29ok( $x->void, 'Inner: Void context' ); 30is_deeply( $x->return, undef, 'Inner: "Returned" ()' ); 31 32# An inner trap localizes $trap, then successfully calls a twice-inner 33# trap. After successful exit from the once-inner trap, $trap reverts 34# to its previous value: 35trap { 36 trap { exit }; 37 is( $trap->leaveby, 'exit', 'Expecting to exit' ); 38 ok( !$trap->list, 'Not list context' ); 39 ok( !$trap->scalar, 'Not scalar context' ); 40 ok( $trap->void, 'Void context' ); 41 is_deeply( $trap->return, undef, 'No return' ); 42 { 43 local $trap; 44 trap { die }; 45 # If the trap / local $trap breaks again, these method calls will 46 # raise an exception, which we might as well catch: 47 is( eval { $trap->leaveby }, 'die', 'Expecting to die' ); 48 ok( eval { !$trap->list }, 'Not list context' ); 49 ok( eval { !$trap->scalar }, 'Not scalar context' ); 50 ok( eval { $trap->void }, 'Void context' ); 51 is_deeply( eval { $trap->return }, undef, 'No return' ); 52 } 53 is( $trap->leaveby, 'exit', 'Revert: Expecting to exit' ); 54 ok( !$trap->list, 'Revert: Not list context' ); 55 ok( !$trap->scalar, 'Revert: Not scalar context' ); 56 ok( $trap->void, 'Revert: Void context' ); 57 is_deeply( $trap->return, undef, 'No return' ); 58}; 59is( $trap->leaveby, 'return', 'Expecting to return' ); 60ok( !$trap->list, 'Not list context' ); 61ok( !$trap->scalar, 'Not scalar context' ); 62ok( $trap->void, 'Void context' ); 63is_deeply( $trap->return, [], 'Void return' ); 64 65# exit compiled to CORE::GLOBAL::exit, which is undefined at runtime ... 66my $flag; 67trap { 68 local *CORE::GLOBAL::exit; 69 trap { exit }; 70 is( $trap->leaveby, 'exit', 'Expecting to have exited' ); 71 exit; # should die! 72 $flag = 1; 73 END { ok( !$flag, 'Code past (dying) exit should compile, but not run' ) } 74}; 75like( $trap->die, qr/^Undefined subroutine &CORE::GLOBAL::exit called at /, 'Dies: Undefined exit()' ); 76