X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCarp.t;h=2ce5eb4dff92da278a3c38d7e40f96ae02bf095c;hb=b1fbf5c3d1dc6dd7934002da04dede2ae2e3ef65;hp=8b9bef98c7b0374f4fc4a531ab77574793c15d34;hpb=22dc90ad47bfa790b556c07d444ffa5b2626a4bf;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Carp.t b/lib/Carp.t index 8b9bef9..2ce5eb4 100644 --- a/lib/Carp.t +++ b/lib/Carp.t @@ -1,31 +1,35 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } +my $Is_VMS = $^O eq 'VMS'; + use Carp qw(carp cluck croak confess); -print "1..19\n"; +plan tests => 21; + +ok 1; -print "ok 1\n"; +{ local $SIG{__WARN__} = sub { + like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' }; -$SIG{__WARN__} = sub { - print "ok $1\n" - if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! }; + carp "ok 2\n"; -carp "ok 2\n"; +} -$SIG{__WARN__} = sub { - print "ok $1\n" - if $_[0] =~ m!(\d+) at.+\b(?i:carp\.t) line \d+$! }; +{ local $SIG{__WARN__} = sub { + like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' }; -carp 3; + carp 3; + +} sub sub_4 { -$SIG{__WARN__} = sub { - print "ok $1\n" - if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$! }; +local $SIG{__WARN__} = sub { + 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' }; cluck 4; @@ -33,42 +37,40 @@ cluck 4; sub_4; -$SIG{__DIE__} = sub { - print "ok $1\n" - if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$! }; +{ local $SIG{__DIE__} = sub { + 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' }; -eval { croak 5 }; + eval { croak 5 }; +} sub sub_6 { - $SIG{__DIE__} = sub { - print "ok $1\n" - 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+$! }; + local $SIG{__DIE__} = sub { + 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' }; eval { confess 6 }; } sub_6; -print "ok 7\n"; +ok(1); # test for caller_info API my $eval = "use Carp::Heavy; return Carp::caller_info(0);"; my %info = eval($eval); -print "not " if ($info{sub_name} ne "eval '$eval'"); -print "ok 8\n"; +is($info{sub_name}, "eval '$eval'", 'caller_info API'); # test for '...::CARP_NOT used only once' warning from Carp::Heavy my $warning; eval { BEGIN { $^W = 1; - $SIG{__WARN__} = + local $SIG{__WARN__} = sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } } } package Z; BEGIN { eval { Carp::croak() } } }; -print $warning ? "not ok 9\n#$warning" : "ok 9\n"; +ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/; # tests for global variables @@ -77,16 +79,15 @@ sub w { cluck @_ } # $Carp::Verbose; { my $aref = [ - qr/t at \S*Carp.t line \d+/, - qr/t at \S*Carp.t line \d+\n\s*main::x\('t'\) called at \S*Carp.t line \d+/ + qr/t at \S*(?i:carp.t) line \d+/, + qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/ ]; - my $test_num = 10; my $i = 0; + my $i = 0; for my $re (@$aref) { local $Carp::Verbose = $i++; local $SIG{__WARN__} = sub { - print "not " unless $_[0] =~ $re; - print "ok ".$test_num++." - Verbose\n"; + like $_[0], $re, 'Verbose'; }; package Z; main::x('t'); @@ -94,28 +95,26 @@ sub w { cluck @_ } } # $Carp::MaxEvalLen -{ my $test_num = 12; +{ my $test_num = 1; for(0,4) { my $txt = "Carp::cluck($test_num)"; local $Carp::MaxEvalLen = $_; local $SIG{__WARN__} = sub { "@_"=~/'(.+?)(?:\n|')/s; - print "not " unless length $1 eq length $_?substr($txt,0,$_):substr($txt,0); - print "ok $test_num - MaxEvalLen\n"; + is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen'; }; eval "$txt"; $test_num++; } } # $Carp::MaxArgLen -{ my $test_num = 14; +{ for(0,4) { my $arg = 'testtest'; local $Carp::MaxArgLen = $_; local $SIG{__WARN__} = sub { "@_"=~/'(.+?)'/; - print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0); - print "ok ".$test_num++." - MaxArgLen\n"; + is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen'; }; package Z; @@ -124,17 +123,16 @@ sub w { cluck @_ } } # $Carp::MaxArgNums -{ my $test_num = 16; my $i = 0; +{ my $i = 0; my $aref = [ - qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*Carp.t line \d+/, - qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*Carp.t line \d+/, + 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+/, + qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/, ]; for(@$aref) { local $Carp::MaxArgNums = $i++; local $SIG{__WARN__} = sub { - print "not " unless "@_"=~$_; - print "ok ".$test_num++." - MaxArgNums\n"; + like "@_", $_, 'MaxArgNums'; }; package Z; @@ -143,20 +141,35 @@ sub w { cluck @_ } } # $Carp::CarpLevel -{ my $test_num = 18; my $i = 0; +{ my $i = 0; my $aref = [ - qr/1 at \S*Carp.t line \d+\n\s*main::w\(1\) called at \S*Carp.t line \d+/, - qr/1 at \S*Carp.t line \d+$/, + qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/, + qr/1 at \S*(?i:carp.t) line \d+$/, ]; for (@$aref) { local $Carp::CarpLevel = $i++; local $SIG{__WARN__} = sub { - print "not " unless "@_"=~$_; - print "ok ".$test_num++." - CarpLevel\n"; + like "@_", $_, 'CarpLevel'; }; package Z; main::w(1); } } + + +{ + local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS; + + # Check that croak() and confess() don't clobber $! + runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})', + stderr => 1); + + is($?>>8, 42, 'croak() doesn\'t clobber $!'); + + runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})', + stderr => 1); + + is($?>>8, 42, 'confess() doesn\'t clobber $!'); +}