This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix [perl #32130] Errno.pm must not pass references to "prototype"
[perl5.git] / lib / Carp.t
CommitLineData
0e25c5fd
JH
1BEGIN {
2 chdir 't' if -d 't';
3 @INC = '../lib';
4}
5
6use Carp qw(carp cluck croak confess);
7
22dc90ad 8print "1..19\n";
0e25c5fd
JH
9
10print "ok 1\n";
11
1115139d
JH
12$SIG{__WARN__} = sub {
13 print "ok $1\n"
22dc90ad 14 if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! };
0e25c5fd 15
1115139d 16carp "ok 2\n";
22dc90ad 17
1115139d
JH
18$SIG{__WARN__} = sub {
19 print "ok $1\n"
22dc90ad 20 if $_[0] =~ m!(\d+) at.+\b(?i:carp\.t) line \d+$! };
0e25c5fd
JH
21
22carp 3;
23
24sub sub_4 {
25
1115139d
JH
26$SIG{__WARN__} = sub {
27 print "ok $1\n"
22dc90ad 28 if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$! };
0e25c5fd
JH
29
30cluck 4;
31
32}
33
34sub_4;
35
1115139d
JH
36$SIG{__DIE__} = sub {
37 print "ok $1\n"
22dc90ad 38 if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$! };
0e25c5fd
JH
39
40eval { croak 5 };
41
42sub sub_6 {
1115139d
JH
43 $SIG{__DIE__} = sub {
44 print "ok $1\n"
22dc90ad 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+$! };
0e25c5fd
JH
46
47 eval { confess 6 };
48}
49
50sub_6;
51
52print "ok 7\n";
53
976ea96e
RS
54# test for caller_info API
55my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
56my %info = eval($eval);
57print "not " if ($info{sub_name} ne "eval '$eval'");
58print "ok 8\n";
b5777b26
RB
59
60# test for '...::CARP_NOT used only once' warning from Carp::Heavy
61my $warning;
62eval {
63 BEGIN {
64 $^W = 1;
65 $SIG{__WARN__} =
66 sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
67 }
22dc90ad 68 package Z;
b5777b26
RB
69 BEGIN { eval { Carp::croak() } }
70};
71print $warning ? "not ok 9\n#$warning" : "ok 9\n";
22dc90ad
JB
72
73
74# tests for global variables
75sub x { carp @_ }
76sub w { cluck @_ }
77
78# $Carp::Verbose;
79{ my $aref = [
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+/
82 ];
83 my $test_num = 10; my $i = 0;
84
85 for my $re (@$aref) {
86 local $Carp::Verbose = $i++;
87 local $SIG{__WARN__} = sub {
88 print "not " unless $_[0] =~ $re;
89 print "ok ".$test_num++." - Verbose\n";
90 };
91 package Z;
92 main::x('t');
93 }
94}
95
96# $Carp::MaxEvalLen
97{ my $test_num = 12;
98 for(0,4) {
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";
105 };
106 eval "$txt"; $test_num++;
107 }
108}
109
110# $Carp::MaxArgLen
111{ my $test_num = 14;
112 for(0,4) {
113 my $arg = 'testtest';
114 local $Carp::MaxArgLen = $_;
115 local $SIG{__WARN__} = sub {
116 "@_"=~/'(.+?)'/;
117 print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0);
118 print "ok ".$test_num++." - MaxArgLen\n";
119 };
120
121 package Z;
122 main::w($arg);
123 }
124}
125
126# $Carp::MaxArgNums
127{ my $test_num = 16; my $i = 0;
128 my $aref = [
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+/,
131 ];
132
133 for(@$aref) {
134 local $Carp::MaxArgNums = $i++;
135 local $SIG{__WARN__} = sub {
136 print "not " unless "@_"=~$_;
137 print "ok ".$test_num++." - MaxArgNums\n";
138 };
139
140 package Z;
141 main::w(1..4);
142 }
143}
144
145# $Carp::CarpLevel
146{ my $test_num = 18; my $i = 0;
147 my $aref = [
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+$/,
150 ];
151
152 for (@$aref) {
153 local $Carp::CarpLevel = $i++;
154 local $SIG{__WARN__} = sub {
155 print "not " unless "@_"=~$_;
156 print "ok ".$test_num++." - CarpLevel\n";
157 };
158
159 package Z;
160 main::w(1);
161 }
162}