develooper Front page | perl.perl5.porters | Postings from August 2003

Re: [perl #15395] lexical warnings and inheritance

Thread Next
From:
Anno Siegel
Date:
August 30, 2003 07:58
Subject:
Re: [perl #15395] lexical warnings and inheritance
Message ID:
200308301408.OAA21308@lublin.zrz.TU-Berlin.DE
Casey West wrote:

> Please consider re-submitting this patch with the proposed updates by Hugo.

Okay, here is a revised patch.

I have since seen that many standard modules take the equivalence of
Carp and warnings for granted.  While I'm still unhappy with the situation
(Carp and warnings growing together), it seems too late for a change.

The patch is against perl-5.8.0-RC3.  It changes only warnings.pl
and deposits a file bug_15395.t.  This contains two tests that establish
that the patch has corrected the undesired behavior.  The idea is to do

    cd perl-5.8.0-RC3
    patch -p0 < /path/to/patch
    perl bug_15395.t # see it fail
    perl warnings.pl # update lib/warnings.pm
    perl bug_15395.t # see it pass

perl-5.8.0-RC3 need only contain warnings.pl and lib/warnings.pm.

Anno
-- 

--- ../../bleadperl/warnings.pl	Thu Jun 20 18:24:36 2002
+++ warnings.pl	Sat Aug 30 15:37:44 2003
@@ -742,16 +742,17 @@
 	$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
 {
--- /dev/null	Sat Aug 30 14:49:01 2003
+++ bug_15395.t	Sat Aug 30 15:46:56 2003
@@ -0,0 +1,56 @@
+#!perl
+
+use lib 'lib';
+
+use Test::More;
+
+my $n_tests;
+BEGIN { $n_tests += 2 }
+
+my ( $warn_cat, # warning category we'll try to control
+     $warn_msg, # the error message to catch
+);
+
+{ # lexical space for tests
+    no warnings; # keep stderr clean
+
+    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?
+like( $@, qr/$warn_msg/, 'can contol');
+
+# does it indicate the right line?
+like( $@, qr/line $warn_line/, 'error location');
+}
+
+BEGIN { plan tests => $n_tests }


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About