Commit | Line | Data |
---|---|---|
0e25c5fd JH |
1 | BEGIN { |
2 | chdir 't' if -d 't'; | |
3 | @INC = '../lib'; | |
ce707141 | 4 | require './test.pl'; |
0e25c5fd JH |
5 | } |
6 | ||
4b09a709 MS |
7 | my $Is_VMS = $^O eq 'VMS'; |
8 | ||
0e25c5fd JH |
9 | use Carp qw(carp cluck croak confess); |
10 | ||
62e1ddac | 11 | plan tests => 21; |
0e25c5fd | 12 | |
ce707141 | 13 | ok 1; |
0e25c5fd | 14 | |
ce707141 CB |
15 | { local $SIG{__WARN__} = sub { |
16 | like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' }; | |
0e25c5fd | 17 | |
ce707141 | 18 | carp "ok 2\n"; |
22dc90ad | 19 | |
ce707141 CB |
20 | } |
21 | ||
22 | { local $SIG{__WARN__} = sub { | |
23 | like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' }; | |
0e25c5fd | 24 | |
ce707141 CB |
25 | carp 3; |
26 | ||
27 | } | |
0e25c5fd JH |
28 | |
29 | sub sub_4 { | |
30 | ||
ce707141 CB |
31 | local $SIG{__WARN__} = sub { |
32 | like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$/, 'cluck 4' }; | |
0e25c5fd JH |
33 | |
34 | cluck 4; | |
35 | ||
36 | } | |
37 | ||
38 | sub_4; | |
39 | ||
ce707141 CB |
40 | { local $SIG{__DIE__} = sub { |
41 | like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$/, 'croak 5' }; | |
0e25c5fd | 42 | |
ce707141 CB |
43 | eval { croak 5 }; |
44 | } | |
0e25c5fd JH |
45 | |
46 | sub sub_6 { | |
ce707141 CB |
47 | local $SIG{__DIE__} = sub { |
48 | like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$/, 'confess 6' }; | |
0e25c5fd JH |
49 | |
50 | eval { confess 6 }; | |
51 | } | |
52 | ||
53 | sub_6; | |
54 | ||
ce707141 | 55 | ok(1); |
0e25c5fd | 56 | |
976ea96e RS |
57 | # test for caller_info API |
58 | my $eval = "use Carp::Heavy; return Carp::caller_info(0);"; | |
59 | my %info = eval($eval); | |
ce707141 | 60 | is($info{sub_name}, "eval '$eval'", 'caller_info API'); |
b5777b26 RB |
61 | |
62 | # test for '...::CARP_NOT used only once' warning from Carp::Heavy | |
63 | my $warning; | |
64 | eval { | |
65 | BEGIN { | |
66 | $^W = 1; | |
ce707141 | 67 | local $SIG{__WARN__} = |
b5777b26 RB |
68 | sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } } |
69 | } | |
22dc90ad | 70 | package Z; |
b5777b26 RB |
71 | BEGIN { eval { Carp::croak() } } |
72 | }; | |
ce707141 | 73 | ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/; |
22dc90ad JB |
74 | |
75 | ||
76 | # tests for global variables | |
77 | sub x { carp @_ } | |
78 | sub w { cluck @_ } | |
79 | ||
80 | # $Carp::Verbose; | |
81 | { my $aref = [ | |
ce707141 CB |
82 | qr/t at \S*(?i:carp.t) line \d+/, |
83 | qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/ | |
22dc90ad | 84 | ]; |
ce707141 | 85 | my $i = 0; |
22dc90ad JB |
86 | |
87 | for my $re (@$aref) { | |
88 | local $Carp::Verbose = $i++; | |
89 | local $SIG{__WARN__} = sub { | |
ce707141 | 90 | like $_[0], $re, 'Verbose'; |
22dc90ad JB |
91 | }; |
92 | package Z; | |
93 | main::x('t'); | |
94 | } | |
95 | } | |
96 | ||
97 | # $Carp::MaxEvalLen | |
ce707141 | 98 | { my $test_num = 1; |
22dc90ad JB |
99 | for(0,4) { |
100 | my $txt = "Carp::cluck($test_num)"; | |
101 | local $Carp::MaxEvalLen = $_; | |
102 | local $SIG{__WARN__} = sub { | |
103 | "@_"=~/'(.+?)(?:\n|')/s; | |
ce707141 | 104 | is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen'; |
22dc90ad JB |
105 | }; |
106 | eval "$txt"; $test_num++; | |
107 | } | |
108 | } | |
109 | ||
110 | # $Carp::MaxArgLen | |
ce707141 | 111 | { |
22dc90ad JB |
112 | for(0,4) { |
113 | my $arg = 'testtest'; | |
114 | local $Carp::MaxArgLen = $_; | |
115 | local $SIG{__WARN__} = sub { | |
116 | "@_"=~/'(.+?)'/; | |
ce707141 | 117 | is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen'; |
22dc90ad JB |
118 | }; |
119 | ||
120 | package Z; | |
121 | main::w($arg); | |
122 | } | |
123 | } | |
124 | ||
125 | # $Carp::MaxArgNums | |
ce707141 | 126 | { my $i = 0; |
22dc90ad | 127 | my $aref = [ |
ce707141 CB |
128 | qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*(?i:carp.t) line \d+/, |
129 | qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/, | |
22dc90ad JB |
130 | ]; |
131 | ||
132 | for(@$aref) { | |
133 | local $Carp::MaxArgNums = $i++; | |
134 | local $SIG{__WARN__} = sub { | |
ce707141 | 135 | like "@_", $_, 'MaxArgNums'; |
22dc90ad JB |
136 | }; |
137 | ||
138 | package Z; | |
139 | main::w(1..4); | |
140 | } | |
141 | } | |
142 | ||
143 | # $Carp::CarpLevel | |
ce707141 | 144 | { my $i = 0; |
22dc90ad | 145 | my $aref = [ |
ce707141 CB |
146 | qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/, |
147 | qr/1 at \S*(?i:carp.t) line \d+$/, | |
22dc90ad JB |
148 | ]; |
149 | ||
150 | for (@$aref) { | |
151 | local $Carp::CarpLevel = $i++; | |
152 | local $SIG{__WARN__} = sub { | |
ce707141 | 153 | like "@_", $_, 'CarpLevel'; |
22dc90ad JB |
154 | }; |
155 | ||
156 | package Z; | |
157 | main::w(1); | |
158 | } | |
159 | } | |
62e1ddac | 160 | |
4b09a709 MS |
161 | |
162 | { | |
163 | local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS; | |
164 | ||
165 | # Check that croak() and confess() don't clobber $! | |
166 | runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})', | |
167 | stderr => 1); | |
168 | ||
169 | is($?>>8, 42, 'croak() doesn\'t clobber $!'); | |
170 | ||
171 | runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})', | |
172 | stderr => 1); | |
173 | ||
174 | is($?>>8, 42, 'confess() doesn\'t clobber $!'); | |
175 | } |