RE: Combining UTF-16 output with :crlf is awkward
[perl.git] / lib / Carp.t
1 BEGIN {
2         chdir 't' if -d 't';
3         @INC = '../lib';
4         require './test.pl';
5 }
6
7 my $Is_VMS = $^O eq 'VMS';
8
9 use Carp qw(carp cluck croak confess);
10
11 plan tests => 21;
12
13 ok 1;
14
15 { local $SIG{__WARN__} = sub {
16     like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' };
17
18   carp  "ok 2\n";
19
20 }
21
22 { local $SIG{__WARN__} = sub {
23     like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' };
24
25   carp 3;
26
27 }
28
29 sub sub_4 {
30
31 local $SIG{__WARN__} = sub {
32     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' };
33
34 cluck 4;
35
36 }
37
38 sub_4;
39
40 { local $SIG{__DIE__} = sub {
41     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' };
42
43   eval { croak 5 };
44 }
45
46 sub sub_6 {
47     local $SIG{__DIE__} = sub {
48         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' };
49
50     eval { confess 6 };
51 }
52
53 sub_6;
54
55 ok(1);
56
57 # test for caller_info API
58 my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
59 my %info = eval($eval);
60 is($info{sub_name}, "eval '$eval'", 'caller_info API');
61
62 # test for '...::CARP_NOT used only once' warning from Carp::Heavy
63 my $warning;
64 eval {
65     BEGIN {
66         $^W = 1;
67         local $SIG{__WARN__} =
68             sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
69     }
70     package Z;
71     BEGIN { eval { Carp::croak() } }
72 };
73 ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
74
75
76 # tests for global variables
77 sub x { carp @_ }
78 sub w { cluck @_ }
79
80 # $Carp::Verbose;
81 {   my $aref = [
82         qr/t at \S*(?i:carp.t) line \d+/,
83         qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/
84     ];
85     my $i = 0;
86
87     for my $re (@$aref) {
88         local $Carp::Verbose = $i++;
89         local $SIG{__WARN__} = sub {
90             like $_[0], $re, 'Verbose';
91         };
92         package Z;
93         main::x('t');
94     }
95 }
96
97 # $Carp::MaxEvalLen
98 {   my $test_num = 1;
99     for(0,4) {
100         my $txt = "Carp::cluck($test_num)";
101         local $Carp::MaxEvalLen = $_;
102         local $SIG{__WARN__} = sub {
103             "@_"=~/'(.+?)(?:\n|')/s;
104             is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen';
105         };
106         eval "$txt"; $test_num++;
107     }
108 }
109
110 # $Carp::MaxArgLen
111 {
112     for(0,4) {
113         my $arg = 'testtest';
114         local $Carp::MaxArgLen = $_;
115         local $SIG{__WARN__} = sub {
116             "@_"=~/'(.+?)'/;
117             is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen';
118         };
119
120         package Z;
121         main::w($arg);
122     }
123 }
124
125 # $Carp::MaxArgNums
126 {   my $i = 0;
127     my $aref = [
128         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+/,
129         qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/,
130     ];
131
132     for(@$aref) {
133         local $Carp::MaxArgNums = $i++;
134         local $SIG{__WARN__} = sub {
135             like "@_", $_, 'MaxArgNums';
136         };
137
138         package Z;
139         main::w(1..4);
140     }
141 }
142
143 # $Carp::CarpLevel
144 {   my $i = 0;
145     my $aref = [
146         qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/,
147         qr/1 at \S*(?i:carp.t) line \d+$/,
148     ];
149
150     for (@$aref) {
151         local $Carp::CarpLevel = $i++;
152         local $SIG{__WARN__} = sub {
153             like "@_", $_, 'CarpLevel';
154         };
155
156         package Z;
157         main::w(1);
158     }
159 }
160
161
162 {
163     local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
164
165     # Check that croak() and confess() don't clobber $!
166     runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})', 
167             stderr => 1);
168
169     is($?>>8, 42, 'croak() doesn\'t clobber $!');
170
171     runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})', 
172             stderr => 1);
173
174     is($?>>8, 42, 'confess() doesn\'t clobber $!');
175 }