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