From ce707141976f2adac9e0ddc6a04f5dded42ef198 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Tue, 26 Oct 2004 18:32:25 -0500 Subject: [PATCH] lib/Carp.t improvements From: "Craig A. Berry" Message-Id: <417F24D9.1000904@mac.com> p4raw-id: //depot/perl@23425 --- lib/Carp.t | 87 +++++++++++++++++++++++++++++--------------------------------- 1 file changed, 41 insertions(+), 46 deletions(-) diff --git a/lib/Carp.t b/lib/Carp.t index 8b9bef9..47f83c9 100644 --- a/lib/Carp.t +++ b/lib/Carp.t @@ -1,31 +1,33 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } use Carp qw(carp cluck croak confess); -print "1..19\n"; +plan tests => 19; -print "ok 1\n"; +ok 1; -$SIG{__WARN__} = sub { - print "ok $1\n" - if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! }; +{ local $SIG{__WARN__} = sub { + like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' }; -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 +35,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 +77,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 +93,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 +121,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,17 +139,16 @@ 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; -- 1.8.3.1