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