6 use Carp qw(carp cluck croak confess);
12 $SIG{__WARN__} = sub {
14 if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! };
18 $SIG{__WARN__} = sub {
20 if $_[0] =~ m!(\d+) at.+\b(?i:carp\.t) line \d+$! };
26 $SIG{__WARN__} = sub {
28 if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$! };
38 if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$! };
45 if $_[0] =~ m!^(\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+$! };
54 # test for caller_info API
55 my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
56 my %info = eval($eval);
57 print "not " if ($info{sub_name} ne "eval '$eval'");
60 # test for '...::CARP_NOT used only once' warning from Carp::Heavy
66 sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
69 BEGIN { eval { Carp::croak() } }
71 print $warning ? "not ok 9\n#$warning" : "ok 9\n";
74 # tests for global variables
80 qr/t at \S*Carp.t line \d+/,
81 qr/t at \S*Carp.t line \d+\n\s*main::x\('t'\) called at \S*Carp.t line \d+/
83 my $test_num = 10; my $i = 0;
86 local $Carp::Verbose = $i++;
87 local $SIG{__WARN__} = sub {
88 print "not " unless $_[0] =~ $re;
89 print "ok ".$test_num++." - Verbose\n";
99 my $txt = "Carp::cluck($test_num)";
100 local $Carp::MaxEvalLen = $_;
101 local $SIG{__WARN__} = sub {
102 "@_"=~/'(.+?)(?:\n|')/s;
103 print "not " unless length $1 eq length $_?substr($txt,0,$_):substr($txt,0);
104 print "ok $test_num - MaxEvalLen\n";
106 eval "$txt"; $test_num++;
113 my $arg = 'testtest';
114 local $Carp::MaxArgLen = $_;
115 local $SIG{__WARN__} = sub {
117 print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0);
118 print "ok ".$test_num++." - MaxArgLen\n";
127 { my $test_num = 16; my $i = 0;
129 qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*Carp.t line \d+/,
130 qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*Carp.t line \d+/,
134 local $Carp::MaxArgNums = $i++;
135 local $SIG{__WARN__} = sub {
136 print "not " unless "@_"=~$_;
137 print "ok ".$test_num++." - MaxArgNums\n";
146 { my $test_num = 18; my $i = 0;
148 qr/1 at \S*Carp.t line \d+\n\s*main::w\(1\) called at \S*Carp.t line \d+/,
149 qr/1 at \S*Carp.t line \d+$/,
153 local $Carp::CarpLevel = $i++;
154 local $SIG{__WARN__} = sub {
155 print "not " unless "@_"=~$_;
156 print "ok ".$test_num++." - CarpLevel\n";