1#!perl -T 2# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/01-*.t" -*- 3 4BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile 5use Test::More tests => 2 + 8*9; 6use strict; 7use warnings; 8 9BEGIN { 10 use_ok( 'Test::Trap', 'trap', '$trap' ); 11} 12 13my $name; # name of the test group 14 15sub is_scalar { 16 ok( !$trap->list, "$name: Not list context" ); 17 ok( $trap->scalar, "$name: Scalar context" ); 18 ok( !$trap->void, "$name: Not void context" ); 19} 20 21sub is_list { 22 ok( $trap->list, "$name: List context" ); 23 ok( !$trap->scalar, "$name: Not scalar context" ); 24 ok( !$trap->void, "$name: Not void context" ); 25} 26 27sub is_void { 28 ok( !$trap->list, "$name: Not list context" ); 29 ok( !$trap->scalar, "$name: Not scalar context" ); 30 ok( $trap->void, "$name: Void context" ); 31} 32 33sub is_return { 34 is( $trap->leaveby, 'return', "$name: Returned" ); 35 is( $trap->die, undef, "$name: No exception trapped" ); 36 is( $trap->exit, undef, "$name: No exit trapped" ); 37} 38 39sub is_die { 40 is( $trap->leaveby, 'die', "$name: Died" ); 41 is_deeply( $trap->return, undef, "$name: Trapped return: none" ); 42 is( $trap->exit, undef, "$name: No exit trapped" ); 43} 44 45sub is_exit { 46 is( $trap->leaveby, 'exit', "$name: Exited" ); 47 is_deeply( $trap->return, undef, "$name: Trapped return: none" ); 48 is( $trap->die, undef, "$name: No exception trapped" ); 49} 50 51my @x = qw( Example text ); 52 53$name = 'Return 2 in scalar context'; 54my $r = trap { @x }; 55is_scalar; 56is_return; 57is( $r, 2, "$name: Return: 2" ); 58is_deeply( $trap->return, [2], "$name: Trapped return: [2]" ); 59 60$name = "Return qw( @x ) in list context"; 61my @r = trap { @x }; 62is_list; 63is_return; 64is_deeply( \@r, \@x, "$name: Return: qw( @x )" ); 65is_deeply( $trap->return, \@x, "$name: Trapped return: [ qw( @x ) ]" ); 66 67$name = 'Return in void context'; 68trap { $r = defined wantarray ? 'non-void' : 'void' }; 69is_void; 70is_return; 71is_deeply( $trap->return, [], "$name: Trapped return: none" ); 72is( $r, 'void', "$name: Extra test -- side effect" ); 73 74$name = 'Die in scalar context'; 75$r = trap { die "My bad 1\n" }; 76is_scalar; 77is_die; 78is( $trap->die, "My bad 1\n", "$name: Trapped exception" ); 79is( $r, undef, "$name: Return: undef" ); 80 81$name = 'Die in list context'; 82@r = trap { die "My bad 2\n" }; 83is_list; 84is_die; 85is( $trap->die, "My bad 2\n", "$name: Trapped exception" ); 86is_deeply( \@r, [], "$name: Return: ()" ); 87 88$name = 'Die in void context'; 89trap { $r = defined wantarray ? 'non-void' : 'still void'; die "My bad 3\n" }; 90is_void; 91is_die; 92is( $trap->die, "My bad 3\n", "$name: Trapped exception" ); 93is( $r, 'still void', "$name: Extra test -- side effect" ); 94 95$name = 'Exit in scalar context'; 96$r = trap { exit 42 }; 97is_scalar; 98is_exit; 99is( $trap->exit, 42, "$name: Trapped exit 42" ); 100is( $r, undef, "$name: Return: undef" ); 101 102$name = 'Exit in list context'; 103@r = trap { exit }; 104is_list; 105is_exit; 106is( $trap->exit, 0, "$name: Trapped exit 0" ); 107is_deeply( \@r, [], "$name: Return: ()" ); 108 109$name = 'Exit in void context'; 110trap { $r = defined wantarray ? 'non-void' : 'and still void'; my @x = qw( a b c d ); exit @x }; 111is_void; 112is_exit; 113is( $trap->exit, 4, "$name: Trapped exit 4" ); 114is( $r, 'and still void', "$name: Extra test -- side effect" ); 115 116exit 0; 117 118my $tricky = 1; 119 120END { 121 is($tricky, undef, ' --==-- END block past exit --==-- '); 122} 123