This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Enable 64bitall builds for Solaris x86
[perl5.git] / lib / Carp.t
CommitLineData
0e25c5fd
JH
1BEGIN {
2 chdir 't' if -d 't';
3 @INC = '../lib';
ce707141 4 require './test.pl';
0e25c5fd
JH
5}
6
7use Carp qw(carp cluck croak confess);
8
62e1ddac 9plan tests => 21;
0e25c5fd 10
ce707141 11ok 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
27sub sub_4 {
28
ce707141
CB
29local $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
32cluck 4;
33
34}
35
36sub_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
44sub 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
51sub_6;
52
ce707141 53ok(1);
0e25c5fd 54
976ea96e
RS
55# test for caller_info API
56my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
57my %info = eval($eval);
ce707141 58is($info{sub_name}, "eval '$eval'", 'caller_info API');
b5777b26
RB
59
60# test for '...::CARP_NOT used only once' warning from Carp::Heavy
61my $warning;
62eval {
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 71ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
22dc90ad
JB
72
73
74# tests for global variables
75sub x { carp @_ }
76sub 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}
62e1ddac
SH
158
159# Check that croak() and confess() don't clobber $!
160runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})', stderr => 1);
161is($?>>8, 42, 'croak() doesn\'t clobber $!');
162runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})', stderr => 1);
163is($?>>8, 42, 'confess() doesn\'t clobber $!');