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