1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
use Carp qw(carp cluck croak confess);
print "1..9\n";
print "ok 1\n";
$SIG{__WARN__} = sub {
print "ok $1\n"
if $_[0] =~ m!ok (\d+)$! };
carp "ok 2\n";
$SIG{__WARN__} = sub {
print "ok $1\n"
if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
carp 3;
sub sub_4 {
$SIG{__WARN__} = sub {
print "ok $1\n"
if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
cluck 4;
}
sub_4;
$SIG{__DIE__} = sub {
print "ok $1\n"
if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
eval { croak 5 };
sub sub_6 {
$SIG{__DIE__} = sub {
print "ok $1\n"
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+$! };
eval { confess 6 };
}
sub_6;
print "ok 7\n";
# test for caller_info API
my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
my %info = eval($eval);
print "not " if ($info{sub_name} ne "eval '$eval'");
print "ok 8\n";
# test for '...::CARP_NOT used only once' warning from Carp::Heavy
my $warning;
eval {
BEGIN {
$^W = 1;
$SIG{__WARN__} =
sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
}
package Z;
BEGIN { eval { Carp::croak() } }
};
print $warning ? "not ok 9\n#$warning" : "ok 9\n";
|
