Re: [perl #15395] lexical warnings and inheritance

[perl5.git] / t / lib / warnings / 9enabled

diff --git a/t/lib/warnings/9enabled b/t/lib/warnings/9enabled
index f5579b2..6d15948 100755 (executable)
--- 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') ;
 --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' ;
 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") ;
 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' ;
 1;
 --FILE-- 
 use warnings 'io' ;


@@ -151,6 +151,7 @@ print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if ! warnings::enabled("io") ;
 1;
 --FILE-- def.pm
 print "ok2\n" if ! warnings::enabled("io") ;
 1;
 --FILE-- def.pm

+package def;

 no warnings;
 use abc ;
 1;
 no warnings;
 use abc ;
 1;


@@ -172,7 +173,7 @@ print "ok3\n" if !warnings::enabled("io") ;
 --FILE-- def.pm
 use warnings 'syntax' ;
 print "ok4\n" if !warnings::enabled('all') ;
 --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--
 use abc ;
 1;
 --FILE--


@@ -197,7 +198,9 @@ sub check {
 --FILE-- 
 use warnings 'syntax' ;
 use abc ;
 --FILE-- 
 use warnings 'syntax' ;
 use abc ;

-eval { abc::check() ; };
+eval { 
+  abc::check() ; 
+};

 print $@ ;
 EXPECT
 ok1
 print $@ ;
 EXPECT
 ok1


@@ -216,7 +219,9 @@ sub check {
 --FILE-- 
 use warnings 'syntax' ;
 use abc ;
 --FILE-- 
 use warnings 'syntax' ;
 use abc ;

-eval { abc::check() ; } ;
+eval { 
+  abc::check() ; 
+  } ;

 print $@ ;
 EXPECT
 ok1
 print $@ ;
 EXPECT
 ok1


@@ -235,7 +240,9 @@ sub check {
 --FILE-- 
 use warnings 'syntax' ;
 require "abc" ;
 --FILE-- 
 use warnings 'syntax' ;
 require "abc" ;

-eval { abc::check() ; } ;
+eval { 
+  abc::check() ; 
+  } ;

 print $@ ;
 EXPECT
 ok1
 print $@ ;
 EXPECT
 ok1


@@ -254,7 +261,10 @@ sub check {
 --FILE-- 
 use warnings 'syntax' ;
 require "abc" ;
 --FILE-- 
 use warnings 'syntax' ;
 require "abc" ;

-eval { use warnings 'io' ; abc::check() ; };
+eval { 
+  use warnings 'io' ; 
+  abc::check() ; 
+};

 abc::check() ; 
 print $@ ;
 EXPECT
 abc::check() ; 
 print $@ ;
 EXPECT


@@ -325,24 +335,32 @@ ok4
 
 # check warnings::warn
 use warnings ;
 
 # check warnings::warn
 use warnings ;

-eval { warnings::warn() } ;
+eval { 
+    warnings::warn() 
+  } ;

 print $@ ;
 print $@ ;

-eval { warnings::warn("fred", "joe") } ;
+eval { 
+  warnings::warn("fred", "joe") 
+  } ;

 print $@ ;
 EXPECT
 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 ;
 ########
 
 # check warnings::warnif
 use warnings ;

-eval { warnings::warnif() } ;
+eval { 
+  warnings::warnif() 
+} ;

 print $@ ;
 print $@ ;

-eval { warnings::warnif("fred", "joe") } ;
+eval { 
+  warnings::warnif("fred", "joe") 
+} ;

 print $@ ;
 EXPECT
 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
 ########
 
 --FILE-- abc.pm


@@ -379,11 +397,12 @@ sub check { warnings::warn("io", "hello") }
 --FILE--
 use warnings qw( FATAL deprecated ) ;
 use abc;
 --FILE--
 use warnings qw( FATAL deprecated ) ;
 use abc;

-eval { abc::check() ; } ;
+eval { 
+    abc::check() ; 
+  } ;

 print "[[$@]]\n";
 EXPECT
 print "[[$@]]\n";
 EXPECT

-hello at - line 3
-       eval {...} called at - line 3
+hello at - line 4

 [[]]
 ########
 
 [[]]
 ########
 


@@ -395,11 +414,12 @@ sub check { warnings::warn("io", "hello") }
 --FILE--
 use warnings qw( FATAL io ) ;
 use abc;
 --FILE--
 use warnings qw( FATAL io ) ;
 use abc;

-eval { abc::check() ; } ;
+eval { 
+  abc::check() ; 
+} ;

 print "[[$@]]\n";
 EXPECT
 print "[[$@]]\n";
 EXPECT

-[[hello at - line 3
-       eval {...} called at - line 3
+[[hello at - line 4

 ]]
 ########
 -W
 ]]
 ########
 -W


@@ -655,11 +675,12 @@ sub check { warnings::warn("hello") }
 --FILE--
 use abc;
 use warnings qw( FATAL deprecated ) ;
 --FILE--
 use abc;
 use warnings qw( FATAL deprecated ) ;

-eval { abc::check() ; } ;
+eval {
+    abc::check() ; 
+  } ;

 print "[[$@]]\n";
 EXPECT
 print "[[$@]]\n";
 EXPECT

-hello at - line 3
-       eval {...} called at - line 3
+hello at - line 4

 [[]]
 ########
 
 [[]]
 ########
 


@@ -671,11 +692,12 @@ sub check { warnings::warn("hello") }
 --FILE--
 use abc;
 use warnings qw( FATAL abc ) ;
 --FILE--
 use abc;
 use warnings qw( FATAL abc ) ;

-eval { abc::check() ; } ;
+eval { 
+  abc::check() ; 
+  } ;

 print "[[$@]]\n";
 EXPECT
 print "[[$@]]\n";
 EXPECT

-[[hello at - line 3
-       eval {...} called at - line 3
+[[hello at - line 4

 ]]
 ########
 -W
 ]]
 ########
 -W


@@ -1023,11 +1045,8 @@ ok2
 ok3
 ok4
 my message 1 at abc.pm line 5
 ok3
 ok4
 my message 1 at abc.pm line 5

-       abc::in1() called at - line 3

 my message 2 at abc.pm line 5
 my message 2 at abc.pm line 5

-       abc::in1() called at - line 3

 my message 3 at abc.pm line 5
 my message 3 at abc.pm line 5

-       abc::in1() called at - line 3

 ########
 
 --FILE-- def.pm
 ########
 
 --FILE-- def.pm


@@ -1160,3 +1179,51 @@ ok5
 my message 1 at - line 8
 my message 2 at - line 8
 my message 4 at - line 8
 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