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 | ||
7 | use Carp qw(carp cluck croak confess); | |
8 | ||
ce707141 | 9 | plan tests => 19; |
0e25c5fd | 10 | |
ce707141 | 11 | ok 1; |
0e25c5fd | 12 | |
ce707141 CB |
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 CB |
18 | } |
19 | ||
20 | { local $SIG{__WARN__} = sub { | |
21 | like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' }; | |
0e25c5fd | 22 | |
ce707141 CB |
23 | carp 3; |
24 | ||
25 | } | |
0e25c5fd JH |
26 | |
27 | sub sub_4 { | |
28 | ||
ce707141 CB |
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 JH |
31 | |
32 | cluck 4; | |
33 | ||
34 | } | |
35 | ||
36 | sub_4; | |
37 | ||
ce707141 CB |
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 CB |
41 | eval { croak 5 }; |
42 | } | |
0e25c5fd JH |
43 | |
44 | sub sub_6 { | |
ce707141 CB |
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 JH |
47 | |
48 | eval { confess 6 }; | |
49 | } | |
50 | ||
51 | sub_6; | |
52 | ||
ce707141 | 53 | ok(1); |
0e25c5fd | 54 | |
976ea96e RS |
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 RB |
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 RB |
66 | sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } } |
67 | } | |
22dc90ad | 68 | package Z; |
b5777b26 RB |
69 | BEGIN { eval { Carp::croak() } } |
70 | }; | |
ce707141 | 71 | ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/; |
22dc90ad JB |
72 | |
73 | ||
74 | # tests for global variables | |
75 | sub x { carp @_ } | |
76 | sub w { cluck @_ } | |
77 | ||
78 | # $Carp::Verbose; | |
79 | { my $aref = [ | |
ce707141 CB |
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 JB |
84 | |
85 | for my $re (@$aref) { | |
86 | local $Carp::Verbose = $i++; | |
87 | local $SIG{__WARN__} = sub { | |
ce707141 | 88 | like $_[0], $re, 'Verbose'; |
22dc90ad JB |
89 | }; |
90 | package Z; | |
91 | main::x('t'); | |
92 | } | |
93 | } | |
94 | ||
95 | # $Carp::MaxEvalLen | |
ce707141 | 96 | { my $test_num = 1; |
22dc90ad JB |
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 JB |
103 | }; |
104 | eval "$txt"; $test_num++; | |
105 | } | |
106 | } | |
107 | ||
108 | # $Carp::MaxArgLen | |
ce707141 | 109 | { |
22dc90ad JB |
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 JB |
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 CB |
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 JB |
128 | ]; |
129 | ||
130 | for(@$aref) { | |
131 | local $Carp::MaxArgNums = $i++; | |
132 | local $SIG{__WARN__} = sub { | |
ce707141 | 133 | like "@_", $_, 'MaxArgNums'; |
22dc90ad JB |
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 CB |
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 JB |
146 | ]; |
147 | ||
148 | for (@$aref) { | |
149 | local $Carp::CarpLevel = $i++; | |
150 | local $SIG{__WARN__} = sub { | |
ce707141 | 151 | like "@_", $_, 'CarpLevel'; |
22dc90ad JB |
152 | }; |
153 | ||
154 | package Z; | |
155 | main::w(1); | |
156 | } | |
157 | } |