extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / Carp.t
1 BEGIN {
2         chdir 't' if -d 't';
3         @INC = '../lib';
4         require './test.pl';
5 }
6
7 use Carp qw(carp cluck croak confess);
8
9 plan tests => 19;
10
11 ok 1;
12
13 { local $SIG{__WARN__} = sub {
14     like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' };
15
16   carp  "ok 2\n";
17
18 }
19
20 { local $SIG{__WARN__} = sub {
21     like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' };
22
23   carp 3;
24
25 }
26
27 sub sub_4 {
28
29 local $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' };
31
32 cluck 4;
33
34 }
35
36 sub_4;
37
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' };
40
41   eval { croak 5 };
42 }
43
44 sub sub_6 {
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' };
47
48     eval { confess 6 };
49 }
50
51 sub_6;
52
53 ok(1);
54
55 # test for caller_info API
56 my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
57 my %info = eval($eval);
58 is($info{sub_name}, "eval '$eval'", 'caller_info API');
59
60 # test for '...::CARP_NOT used only once' warning from Carp::Heavy
61 my $warning;
62 eval {
63     BEGIN {
64         $^W = 1;
65         local $SIG{__WARN__} =
66             sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
67     }
68     package Z;
69     BEGIN { eval { Carp::croak() } }
70 };
71 ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
72
73
74 # tests for global variables
75 sub x { carp @_ }
76 sub w { cluck @_ }
77
78 # $Carp::Verbose;
79 {   my $aref = [
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+/
82     ];
83     my $i = 0;
84
85     for my $re (@$aref) {
86         local $Carp::Verbose = $i++;
87         local $SIG{__WARN__} = sub {
88             like $_[0], $re, 'Verbose';
89         };
90         package Z;
91         main::x('t');
92     }
93 }
94
95 # $Carp::MaxEvalLen
96 {   my $test_num = 1;
97     for(0,4) {
98         my $txt = "Carp::cluck($test_num)";
99         local $Carp::MaxEvalLen = $_;
100         local $SIG{__WARN__} = sub {
101             "@_"=~/'(.+?)(?:\n|')/s;
102             is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen';
103         };
104         eval "$txt"; $test_num++;
105     }
106 }
107
108 # $Carp::MaxArgLen
109 {
110     for(0,4) {
111         my $arg = 'testtest';
112         local $Carp::MaxArgLen = $_;
113         local $SIG{__WARN__} = sub {
114             "@_"=~/'(.+?)'/;
115             is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen';
116         };
117
118         package Z;
119         main::w($arg);
120     }
121 }
122
123 # $Carp::MaxArgNums
124 {   my $i = 0;
125     my $aref = [
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+/,
128     ];
129
130     for(@$aref) {
131         local $Carp::MaxArgNums = $i++;
132         local $SIG{__WARN__} = sub {
133             like "@_", $_, 'MaxArgNums';
134         };
135
136         package Z;
137         main::w(1..4);
138     }
139 }
140
141 # $Carp::CarpLevel
142 {   my $i = 0;
143     my $aref = [
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+$/,
146     ];
147
148     for (@$aref) {
149         local $Carp::CarpLevel = $i++;
150         local $SIG{__WARN__} = sub {
151             like "@_", $_, 'CarpLevel';
152         };
153
154         package Z;
155         main::w(1);
156     }
157 }