diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Carp.pm | 1 | ||||
-rw-r--r-- | lib/warnings.pm | 22 |
2 files changed, 14 insertions, 9 deletions
diff --git a/lib/Carp.pm b/lib/Carp.pm index 5dbae299fd..6199f89448 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 0b32815e25..8c4791370e 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 && |