diff options
| -rw-r--r-- | lib/warnings.pm | 11 | ||||
| -rwxr-xr-x | t/lib/warnings/9enabled | 54 | ||||
| -rw-r--r-- | warnings.pl | 11 |
3 files changed, 63 insertions, 13 deletions
diff --git a/lib/warnings.pm b/lib/warnings.pm index edbe1a7c74..9e9b3b55ca 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -439,17 +439,18 @@ sub __chk $i -= 2 ; } else { - for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) { - last if $pkg ne $this_pkg ; - } - $i = 2 - if !$pkg || $pkg eq $this_pkg ; + $i = _error_loc(); # see where Carp will allocate the error } my $callers_bitmask = (caller($i))[9] ; return ($callers_bitmask, $offset, $i) ; } +sub _error_loc { + require Carp::Heavy; + goto &Carp::short_error_loc; # don't introduce another stack frame +} + sub enabled { Croaker("Usage: warnings::enabled([category])") diff --git a/t/lib/warnings/9enabled b/t/lib/warnings/9enabled index 99d32e54e8..6d15948ed4 100755 --- a/t/lib/warnings/9enabled +++ b/t/lib/warnings/9enabled @@ -47,7 +47,7 @@ ok2 --FILE-- abc no warnings ; print "ok1\n" if !warnings::enabled('all') ; -print "ok2\n" if warnings::enabled("syntax") ; +print "ok2\n" if !warnings::enabled("syntax") ; 1; --FILE-- use warnings 'syntax' ; @@ -61,7 +61,7 @@ ok2 use warnings 'syntax' ; print "ok1\n" if ! warnings::enabled('all') ; print "ok2\n" if ! warnings::enabled("syntax") ; -print "ok3\n" if warnings::enabled("io") ; +print "ok3\n" if ! warnings::enabled("io") ; 1; --FILE-- use warnings 'io' ; @@ -173,7 +173,7 @@ print "ok3\n" if !warnings::enabled("io") ; --FILE-- def.pm use warnings 'syntax' ; print "ok4\n" if !warnings::enabled('all') ; -print "ok5\n" if warnings::enabled("io") ; +print "ok5\n" if !warnings::enabled("io") ; use abc ; 1; --FILE-- @@ -1179,3 +1179,51 @@ ok5 my message 1 at - line 8 my message 2 at - line 8 my message 4 at - line 8 +######## + +--FILE-- +# test for bug [perl #15395] +my ( $warn_cat, # warning category we'll try to control + $warn_msg, # the error message to catch +); + +package SomeModule; +use warnings::register; + +BEGIN { + $warn_cat = __PACKAGE__; + $warn_msg = 'from ' . __PACKAGE__; +} + +# a sub that generates a random warning +sub gen_warning { + warnings::warnif( $warn_msg ); +} + +package ClientModule; +# use SomeModule; (would go here) +our @CARP_NOT = ( $warn_cat ); # deliver warnings to *our* client + +# call_warner provokes a warning. It is delivered to its caller, +# who should also be able to control it +sub call_warner { + SomeModule::gen_warning(); +} + +# user + +package main; +my $warn_line = __LINE__ + 3; # this line should be in the error message +eval { + use warnings FATAL => $warn_cat; # we want to know if this works + ClientModule::call_warner(); +}; + +# have we caught an error, and is it the one we generated? +print "ok1\n" if $@ =~ /$warn_msg/; + +# does it indicate the right line? +print "ok2\n" if $@ =~ /line $warn_line/; +EXPECT +ok1 +ok2 diff --git a/warnings.pl b/warnings.pl index 61779528ec..7feccb5751 100644 --- a/warnings.pl +++ b/warnings.pl @@ -747,17 +747,18 @@ sub __chk $i -= 2 ; } else { - for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) { - last if $pkg ne $this_pkg ; - } - $i = 2 - if !$pkg || $pkg eq $this_pkg ; + $i = _error_loc(); # see where Carp will allocate the error } my $callers_bitmask = (caller($i))[9] ; return ($callers_bitmask, $offset, $i) ; } +sub _error_loc { + require Carp::Heavy; + goto &Carp::short_error_loc; # don't introduce another stack frame +} + sub enabled { Croaker("Usage: warnings::enabled([category])") |