From: Paul Marquess Date: Sun, 24 Mar 2002 23:00:21 +0000 (+0000) Subject: fix warning + carp interaction X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c3186b657097c822f3b2e667eea90ac8342b05f0;p=p5sagit%2Fp5-mst-13.2.git fix warning + carp interaction From: "Paul Marquess" Message-ID: p4raw-id: //depot/perl@15481 --- diff --git a/lib/Carp.pm b/lib/Carp.pm index 5dbae29..6199f89 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -119,6 +119,7 @@ call die() or warn(), as appropriate. # text and function arguments should be formatted when printed. $CarpInternal{Carp}++; +$CarpInternal{warnings}++; $CarpLevel = 0; # How many extra package levels to skip on carp. # How many calls to skip on confess. # Reconciling these notions is hard, use diff --git a/lib/warnings.pm b/lib/warnings.pm index 0b32815..8c47913 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -278,6 +278,12 @@ $BYTES = 12 ; $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; +sub Croaker +{ + delete $Carp::CarpInternal{'warnings'}; + croak @_ ; +} + sub bits { my $mask ; my $catmask ; @@ -291,7 +297,7 @@ sub bits { $mask |= $DeadBits{$word} if $fatal ; } else - { croak("Unknown warnings category '$word'")} + { Croaker("Unknown warnings category '$word'")} } return $mask ; @@ -327,19 +333,19 @@ sub __chk # check the category supplied. $category = shift ; if (ref $category) { - croak ("not an object") + Croaker ("not an object") if $category !~ /^([^=]+)=/ ; $category = $1 ; $isobj = 1 ; } $offset = $Offsets{$category}; - croak("Unknown warnings category '$category'") + Croaker("Unknown warnings category '$category'") unless defined $offset; } else { $category = (caller(1))[0] ; $offset = $Offsets{$category}; - croak("package '$category' not registered for warnings") + Croaker("package '$category' not registered for warnings") unless defined $offset ; } @@ -367,7 +373,7 @@ sub __chk sub enabled { - croak("Usage: warnings::enabled([category])") + Croaker("Usage: warnings::enabled([category])") unless @_ == 1 || @_ == 0 ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; @@ -380,12 +386,11 @@ sub enabled sub warn { - croak("Usage: warnings::warn([category,] 'message')") + Croaker("Usage: warnings::warn([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; @@ -394,12 +399,11 @@ sub warn sub warnif { - croak("Usage: warnings::warnif([category,] 'message')") + Croaker("Usage: warnings::warnif([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; return unless defined $callers_bitmask && diff --git a/t/lib/warnings/9enabled b/t/lib/warnings/9enabled index fdce8cd..99d32e5 100755 --- a/t/lib/warnings/9enabled +++ b/t/lib/warnings/9enabled @@ -198,7 +198,9 @@ sub check { --FILE-- use warnings 'syntax' ; use abc ; -eval { abc::check() ; }; +eval { + abc::check() ; +}; print $@ ; EXPECT ok1 @@ -217,7 +219,9 @@ sub check { --FILE-- use warnings 'syntax' ; use abc ; -eval { abc::check() ; } ; +eval { + abc::check() ; + } ; print $@ ; EXPECT ok1 @@ -236,7 +240,9 @@ sub check { --FILE-- use warnings 'syntax' ; require "abc" ; -eval { abc::check() ; } ; +eval { + abc::check() ; + } ; print $@ ; EXPECT ok1 @@ -255,7 +261,10 @@ sub check { --FILE-- use warnings 'syntax' ; require "abc" ; -eval { use warnings 'io' ; abc::check() ; }; +eval { + use warnings 'io' ; + abc::check() ; +}; abc::check() ; print $@ ; EXPECT @@ -326,24 +335,32 @@ ok4 # check warnings::warn use warnings ; -eval { warnings::warn() } ; +eval { + warnings::warn() + } ; print $@ ; -eval { warnings::warn("fred", "joe") } ; +eval { + warnings::warn("fred", "joe") + } ; print $@ ; EXPECT -Usage: warnings::warn([category,] 'message') at - line 4 -Unknown warnings category 'fred' at - line 6 +Usage: warnings::warn([category,] 'message') at - line 5 +Unknown warnings category 'fred' at - line 9 ######## # check warnings::warnif use warnings ; -eval { warnings::warnif() } ; +eval { + warnings::warnif() +} ; print $@ ; -eval { warnings::warnif("fred", "joe") } ; +eval { + warnings::warnif("fred", "joe") +} ; print $@ ; EXPECT -Usage: warnings::warnif([category,] 'message') at - line 4 -Unknown warnings category 'fred' at - line 6 +Usage: warnings::warnif([category,] 'message') at - line 5 +Unknown warnings category 'fred' at - line 9 ######## --FILE-- abc.pm @@ -380,11 +397,12 @@ sub check { warnings::warn("io", "hello") } --FILE-- use warnings qw( FATAL deprecated ) ; use abc; -eval { abc::check() ; } ; +eval { + abc::check() ; + } ; print "[[$@]]\n"; EXPECT -hello at - line 3 - eval {...} called at - line 3 +hello at - line 4 [[]] ######## @@ -396,11 +414,12 @@ sub check { warnings::warn("io", "hello") } --FILE-- use warnings qw( FATAL io ) ; use abc; -eval { abc::check() ; } ; +eval { + abc::check() ; +} ; print "[[$@]]\n"; EXPECT -[[hello at - line 3 - eval {...} called at - line 3 +[[hello at - line 4 ]] ######## -W @@ -656,11 +675,12 @@ sub check { warnings::warn("hello") } --FILE-- use abc; use warnings qw( FATAL deprecated ) ; -eval { abc::check() ; } ; +eval { + abc::check() ; + } ; print "[[$@]]\n"; EXPECT -hello at - line 3 - eval {...} called at - line 3 +hello at - line 4 [[]] ######## @@ -672,11 +692,12 @@ sub check { warnings::warn("hello") } --FILE-- use abc; use warnings qw( FATAL abc ) ; -eval { abc::check() ; } ; +eval { + abc::check() ; + } ; print "[[$@]]\n"; EXPECT -[[hello at - line 3 - eval {...} called at - line 3 +[[hello at - line 4 ]] ######## -W @@ -1024,11 +1045,8 @@ ok2 ok3 ok4 my message 1 at abc.pm line 5 - abc::in1() called at - line 3 my message 2 at abc.pm line 5 - abc::in1() called at - line 3 my message 3 at abc.pm line 5 - abc::in1() called at - line 3 ######## --FILE-- def.pm diff --git a/warnings.pl b/warnings.pl index 9a13cf0..9149f69 100644 --- a/warnings.pl +++ b/warnings.pl @@ -522,6 +522,12 @@ KEYWORDS $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; +sub Croaker +{ + delete $Carp::CarpInternal{'warnings'}; + croak @_ ; +} + sub bits { my $mask ; my $catmask ; @@ -535,7 +541,7 @@ sub bits { $mask |= $DeadBits{$word} if $fatal ; } else - { croak("Unknown warnings category '$word'")} + { Croaker("Unknown warnings category '$word'")} } return $mask ; @@ -571,19 +577,19 @@ sub __chk # check the category supplied. $category = shift ; if (ref $category) { - croak ("not an object") + Croaker ("not an object") if $category !~ /^([^=]+)=/ ; $category = $1 ; $isobj = 1 ; } $offset = $Offsets{$category}; - croak("Unknown warnings category '$category'") + Croaker("Unknown warnings category '$category'") unless defined $offset; } else { $category = (caller(1))[0] ; $offset = $Offsets{$category}; - croak("package '$category' not registered for warnings") + Croaker("package '$category' not registered for warnings") unless defined $offset ; } @@ -611,7 +617,7 @@ sub __chk sub enabled { - croak("Usage: warnings::enabled([category])") + Croaker("Usage: warnings::enabled([category])") unless @_ == 1 || @_ == 0 ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; @@ -624,12 +630,11 @@ sub enabled sub warn { - croak("Usage: warnings::warn([category,] 'message')") + Croaker("Usage: warnings::warn([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; @@ -638,12 +643,11 @@ sub warn sub warnif { - croak("Usage: warnings::warnif([category,] 'message')") + Croaker("Usage: warnings::warnif([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; return unless defined $callers_bitmask &&