final touches for lexical warnings (from Paul Marquess)

p4raw-id: //depot/perl@5702

9 files changed, 529 insertions, 45 deletions

diff --git a/t/lib/filepath.t b/t/lib/filepath.t
index 40e6e213c1..5628d0c726 100755
--- a/t/lib/filepath.t
+++ b/t/lib/filepath.t
@@ -9,7 +9,7 @@ use File::Path;
 use strict;
 
 my $count = 0;
-$^W = 1;
+use warnings;
 
 print "1..4\n";
 
diff --git a/t/lib/io_sel.t b/t/lib/io_sel.t
index e0d7a45338..85e14ab0c0 100755
--- a/t/lib/io_sel.t
+++ b/t/lib/io_sel.t
@@ -10,7 +10,7 @@ BEGIN {
 select(STDERR); $| = 1;
 select(STDOUT); $| = 1;
 
-print "1..21\n";
+print "1..23\n";
 
 use IO::Select 1.09;
 
@@ -114,3 +114,19 @@ print "ok 20\n";
 $sel->remove($sel->handles);
 print "not " unless $sel->count == 0 && !defined($sel->bits);
 print "ok 21\n";
+
+# check warnings
+$SIG{__WARN__} = sub { 
+    ++ $w 
+      if $_[0] =~ /^Call to depreciated method 'has_error', use 'has_exception'/ 
+    } ;
+$w = 0 ;
+IO::Select::has_error();
+print "not " unless $w == 0 ;
+$w = 0 ;
+print "ok 22\n" ;
+use warnings 'IO::Select' ;
+IO::Select::has_error();
+print "not " unless $w == 1 ;
+$w = 0 ;
+print "ok 23\n" ;
diff --git a/t/lib/socket.t b/t/lib/socket.t
index 8f945ac6f7..d5e1848a3e 100755
--- a/t/lib/socket.t
+++ b/t/lib/socket.t
@@ -13,7 +13,7 @@ BEGIN {
 	
 use Socket;
 
-print "1..6\n";
+print "1..8\n";
 
 if (socket(T,PF_INET,SOCK_STREAM,6)) {
   print "ok 1\n";
@@ -74,3 +74,14 @@ else {
 	print "# $!\n";
 	print "not ok 4\n";
 }
+
+# warnings
+$SIG{__WARN__} = sub {
+    ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
+} ;
+$w = 0 ;
+sockaddr_in(1,2,3,4,5,6) ;
+print ($w == 1 ? "not ok 7\n" : "ok 7\n") ;
+use warnings 'Socket' ;
+sockaddr_in(1,2,3,4,5,6) ;
+print ($w == 1 ? "ok 8\n" : "not ok 8\n") ;
diff --git a/t/lib/tie-stdhandle.t b/t/lib/tie-stdhandle.t
index cb8303d94d..cf3a1831d0 100755
--- a/t/lib/tie-stdhandle.t
+++ b/t/lib/tie-stdhandle.t
@@ -45,5 +45,3 @@ print "ok 12\n";
 print "not " unless close($f);
 print "ok 13\n";
 unlink("afile");     
-
-
diff --git a/t/op/tie.t b/t/op/tie.t
index 105b1d6f18..9543420a42 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -78,7 +78,6 @@ EXPECT
 
 # strict behaviour, without any extra references
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 untie %h;
@@ -87,7 +86,6 @@ EXPECT
 
 # strict behaviour, with 1 extra references generating an error
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 untie %h;
@@ -97,7 +95,6 @@ untie attempted while 1 inner references still exist
 
 # strict behaviour, with 1 extra references via tied generating an error
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
@@ -108,7 +105,6 @@ untie attempted while 1 inner references still exist
 
 # strict behaviour, with 1 extra references which are destroyed
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $a = 0 ;
@@ -118,7 +114,6 @@ EXPECT
 
 # strict behaviour, with extra 1 references via tied which are destroyed
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
@@ -129,7 +124,6 @@ EXPECT
 
 # strict error behaviour, with 2 extra references 
 use warnings 'untie';
-#local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $b = tied %h ;
@@ -140,13 +134,11 @@ untie attempted while 2 inner references still exist
 
 # strict behaviour, check scope of strictness.
 no warnings 'untie';
-#local $^W = 0 ;
 use Tie::Hash ;
 $A = tie %H, Tie::StdHash;
 $C = $B = tied %H ;
 {
     use warnings 'untie';
-    #local $^W = 1 ;
     use Tie::Hash ;
     tie %h, Tie::StdHash;
     untie %h;
diff --git a/t/pragma/constant.t b/t/pragma/constant.t
index 5904a4f2b6..443bcf6423 100755
--- a/t/pragma/constant.t
+++ b/t/pragma/constant.t
@@ -14,7 +14,7 @@ END { print @warnings }
 
 ######################### We start with some black magic to print on failure.
 
-BEGIN { $| = 1; print "1..58\n"; }
+BEGIN { $| = 1; print "1..73\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use constant 1.01;
 $loaded = 1;
@@ -96,11 +96,8 @@ test 23, length(MESS) == 8;
 
 use constant TRAILING	=> '12 cats';
 {
-    my $save_warn;
-    local $^W;
-    BEGIN { $save_warn = $^W; $^W = 0 }
+    no warnings 'numeric';
     test 24, TRAILING == 12;
-    BEGIN { $^W = $save_warn }
 }
 test 25, TRAILING eq '12 cats';
 
@@ -194,3 +191,41 @@ test 52, !$constant::declared{'main::PIE'};
 
 test 57, declared 'Other::IN_OTHER_PACK';
 test 58, $constant::declared{'Other::IN_OTHER_PACK'};
+
+@warnings = ();
+eval q{
+{
+    use warnings 'constant';
+    use constant 'BEGIN' => 1 ;
+    use constant 'INIT' => 1 ;
+    use constant 'CHECK' => 1 ;
+    use constant 'END' => 1 ;
+    use constant 'DESTROY' => 1 ;
+    use constant 'AUTOLOAD' => 1 ;
+    use constant 'STDIN' => 1 ;
+    use constant 'STDOUT' => 1 ;
+    use constant 'STDERR' => 1 ;
+    use constant 'ARGV' => 1 ;
+    use constant 'ARGVOUT' => 1 ;
+    use constant 'ENV' => 1 ;
+    use constant 'INC' => 1 ;
+    use constant 'SIG' => 1 ;
+}
+};
+
+test 59, @warnings == 14 ;
+test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
+test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
+test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
+test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
+test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
+test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
+test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
+test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
+test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
+test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
+test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
+test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
+test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
+test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
+@warnings = ();
diff --git a/t/pragma/diagnostics.t b/t/pragma/diagnostics.t
index 8c9a152a18..15cd6b5927 100755
--- a/t/pragma/diagnostics.t
+++ b/t/pragma/diagnostics.t
@@ -11,11 +11,12 @@ BEGIN {
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 use strict;
+use warnings;
 
 use vars qw($Test_Num $Total_tests);
 
 my $loaded;
-BEGIN { $| = 1; $^W = 1; $Test_Num = 1 }
+BEGIN { $| = 1; $Test_Num = 1 }
 END {print "not ok $Test_Num\n" unless $loaded;}
 print "1..$Total_tests\n";
 BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use
index 396f20142c..60a60c313c 100644
--- a/t/pragma/warn/2use
+++ b/t/pragma/warn/2use
@@ -5,9 +5,11 @@ TODO
 
 __END__
 
-# ignore unknown warning categories
+#  check illegal category is caught
 use warnings 'this-should-never-be-a-warning-category' ;
 EXPECT
+unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
+BEGIN failed--compilation aborted at - line 3.
 ########
 
 # Check compile time scope of pragma
diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled
index 1ecf24a0c0..7facf996f5 100755
--- a/t/pragma/warn/9enabled
+++ b/t/pragma/warn/9enabled
@@ -5,7 +5,7 @@ __END__
 --FILE-- abc.pm
 package abc ;
 use warnings "io" ;
-print "ok1\n" if ! warnings::enabled() ;
+print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if ! warnings::enabled("io") ;
 1;
 --FILE-- 
@@ -19,7 +19,7 @@ ok2
 --FILE-- abc.pm
 package abc ;
 no warnings ;
-print "ok1\n" if warnings::enabled() ;
+print "ok1\n" if !warnings::enabled('all') ;
 print "ok2\n" if warnings::enabled("syntax") ;
 1;
 --FILE-- 
@@ -33,7 +33,7 @@ ok2
 --FILE-- abc.pm
 package abc ;
 use warnings 'syntax' ;
-print "ok1\n" if   warnings::enabled() ;
+print "ok1\n" if   warnings::enabled('io') ;
 print "ok2\n" if ! warnings::enabled("syntax") ;
 1;
 --FILE-- 
@@ -46,7 +46,7 @@ ok2
 
 --FILE-- abc
 no warnings ;
-print "ok1\n" if warnings::enabled() ;
+print "ok1\n" if !warnings::enabled('all') ;
 print "ok2\n" if warnings::enabled("syntax") ;
 1;
 --FILE-- 
@@ -59,7 +59,7 @@ ok2
 
 --FILE-- abc
 use warnings 'syntax' ;
-print "ok1\n" if   warnings::enabled ;
+print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if ! warnings::enabled("syntax") ;
 print "ok3\n" if   warnings::enabled("io") ;
 1;
@@ -76,7 +76,7 @@ ok3
 package abc ;
 no warnings ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
+  print "ok1\n" if !warnings::enabled('all') ;
   print "ok2\n" if warnings::enabled("syntax") ;
 }
 1;
@@ -93,8 +93,8 @@ ok2
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if  warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
   print "ok3\n" if ! warnings::enabled("io") ;
 }
 1;
@@ -112,7 +112,7 @@ ok3
 package abc ;
 no warnings ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
+  print "ok1\n" if !warnings::enabled('all') ;
   print "ok2\n" if warnings::enabled("syntax") ;
 }
 1;
@@ -129,8 +129,8 @@ ok2
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
-  print "ok2\n" if warnings::enabled("syntax") ;
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
   print "ok3\n" if ! warnings::enabled("io") ;
 }
 1;
@@ -147,7 +147,7 @@ ok3
 --FILE-- abc.pm
 package abc ;
 use warnings "io" ;
-print "ok1\n" if ! warnings::enabled() ;
+print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if ! warnings::enabled("io") ;
 1;
 --FILE-- def.pm
@@ -165,13 +165,13 @@ ok2
 --FILE-- abc.pm
 package abc ;
 no warnings ;
-print "ok1\n" if warnings::enabled() ;
+print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if warnings::enabled("syntax") ;
 print "ok3\n" if !warnings::enabled("io") ;
 1;
 --FILE-- def.pm
 use warnings 'syntax' ;
-print "ok4\n" if warnings::enabled() ;
+print "ok4\n" if !warnings::enabled('all') ;
 print "ok5\n" if warnings::enabled("io") ;
 use abc ;
 1;
@@ -190,7 +190,7 @@ ok5
 package abc ;
 no warnings ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
+  print "ok1\n" if !warnings::enabled('all') ;
   print "ok2\n" if warnings::enabled("syntax") ;
 }
 1;
@@ -208,8 +208,8 @@ ok2
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if  warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
   print "ok3\n" if ! warnings::enabled("io") ;
 }
 1;
@@ -228,7 +228,7 @@ ok3
 package abc ;
 no warnings ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
+  print "ok1\n" if !warnings::enabled('all') ;
   print "ok2\n" if warnings::enabled("syntax") ;
 }
 1;
@@ -246,7 +246,7 @@ ok2
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if warnings::enabled ;
+  print "ok1\n" if !warnings::enabled('all') ;
   print "ok2\n" if warnings::enabled("syntax") ;
   print "ok3\n" if warnings::enabled("io") ;
 }
@@ -269,7 +269,7 @@ ok2
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if  warnings::enabled ;
+  print "ok1\n" if ! warnings::enabled('all') ;
   print "ok2\n" if  warnings::enabled("syntax") ;
   print "ok3\n" if ! warnings::enabled("io") ;
 }
@@ -289,7 +289,7 @@ ok3
 package abc ;
 use warnings 'io' ;
 sub check {
-  print "ok1\n" if  ! warnings::enabled ;
+  print "ok1\n" if  ! warnings::enabled('all') ;
 }
 1;
 --FILE-- 
@@ -305,7 +305,7 @@ ok1
 package abc ;
 use warnings 'misc' ;
 sub check {
-  print "ok1\n" if  warnings::enabled ;
+  print "ok1\n" if  ! warnings::enabled('all') ;
   print "ok2\n" if  warnings::enabled("syntax") ;
   print "ok3\n" if  warnings::enabled("io") ;
   print "ok4\n" if  ! warnings::enabled("misc") ;
@@ -327,11 +327,12 @@ ok4
 use warnings ;
 eval { warnings::warn() } ;
 print $@ ;
-eval { warnings::warn("fred") } ;
+eval { warnings::warn("fred", "joe") } ;
 print $@ ;
 EXPECT
-Usage: warnings::warn('category', 'message') at - line 4
-Usage: warnings::warn('category', 'message') at - line 6
+Usage: warnings::warn([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+	require 0 called at - line 6
 ########
 
 --FILE-- abc.pm
@@ -388,3 +389,431 @@ print "[[$@]]\n";
 EXPECT
 [[hello at - line 3
 ]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if warnings::enabled("io") ;
+print "ok2\n" if warnings::enabled("all") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if !warnings::enabled("io") ;
+print "ok2\n" if !warnings::enabled("all") ;
+1;
+--FILE-- 
+use warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok\n" if ! warnings::enabled() ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if warnings::enabled ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings "abc" ;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL deprecated ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL abc ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use warnings 'all';
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
+  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- def.pm
+package def ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
+  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- 
+use abc ;
+use def ;
+use warnings 'abc';
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+no warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings;
+abc::check() ;
+def::check() ;
+no warnings 'abc' ;
+abc::check() ;
+def::check() ;
+EXPECT
+abc self enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all enabled
+def self enabled
+def abc enabled
+def all enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled