1BEGIN {
2	chdir 't' if -d 't';
3	@INC = '../lib';
4	require './test.pl';
5}
6
7my $Is_VMS = $^O eq 'VMS';
8
9use Carp qw(carp cluck croak confess);
10
11plan tests => 21;
12
13ok 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
29sub sub_4 {
30
31local $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
34cluck 4;
35
36}
37
38sub_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
46sub 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
53sub_6;
54
55ok(1);
56
57# test for caller_info API
58my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
59my %info = eval($eval);
60is($info{sub_name}, "eval '$eval'", 'caller_info API');
61
62# test for '...::CARP_NOT used only once' warning from Carp::Heavy
63my $warning;
64eval {
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};
73ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
74
75
76# tests for global variables
77sub x { carp @_ }
78sub 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}
176