final touches for lexical warnings (from Paul Marquess)

p4raw-id: //depot/perl@5702

28 files changed, 1097 insertions, 364 deletions

diff --git a/MANIFEST b/MANIFEST
index f8ea07a032..f097747485 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -939,6 +939,7 @@ lib/utf8_heavy.pl				Support routines for utf8 pragma
 lib/validate.pl		Perl library supporting wholesale file mode validation
 lib/vars.pm		Declare pseudo-imported global variables
 lib/warnings.pm		For "use warnings"
+lib/warnings/register.pm	For "use warnings::register"
 makeaperl.SH		perl script that produces a new perl binary
 makedef.pl		Create symbol export lists for linking
 makedepend.SH		Precursor to makedepend
diff --git a/ext/IO/lib/IO/Select.pm b/ext/IO/lib/IO/Select.pm
index 1d8cda6fbf..df92b04b74 100644
--- a/ext/IO/lib/IO/Select.pm
+++ b/ext/IO/lib/IO/Select.pm
@@ -7,10 +7,11 @@
 package IO::Select;
 
 use     strict;
+use warnings::register;
 use     vars qw($VERSION @ISA);
 require Exporter;
 
-$VERSION = "1.13";
+$VERSION = "1.14";
 
 @ISA = qw(Exporter); # This is only so we can do version checking
 
@@ -129,9 +130,8 @@ sub has_exception
 
 sub has_error
 {
- require Carp;
- Carp::carp("Call to depreciated method 'has_error', use 'has_exception'")
-	if $^W;
+ warnings::warn("Call to depreciated method 'has_error', use 'has_exception'")
+	if warnings::enabled();
  goto &has_exception;
 }
 
diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm
index f83cb18399..02f098df77 100644
--- a/ext/Socket/Socket.pm
+++ b/ext/Socket/Socket.pm
@@ -1,7 +1,7 @@
 package Socket;
 
 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = "1.71";
+$VERSION = "1.72";
 
 =head1 NAME
 
@@ -160,6 +160,7 @@ have AF_UNIX in the right place.
 =cut
 
 use Carp;
+use warnings::register;
 
 require Exporter;
 use XSLoader ();
@@ -302,7 +303,8 @@ BEGIN {
 sub sockaddr_in {
     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
 	my($af, $port, @quad) = @_;
-	carp "6-ARG sockaddr_in call is deprecated" if $^W;
+	warnings::warn "6-ARG sockaddr_in call is deprecated" 
+	    if warnings::enabled();
 	pack_sockaddr_in($port, inet_aton(join('.', @quad)));
     } elsif (wantarray) {
 	croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
index b4f2117557..63eddac739 100644
--- a/lib/Class/Struct.pm
+++ b/lib/Class/Struct.pm
@@ -5,6 +5,7 @@ package Class::Struct;
 use 5.005_64;
 
 use strict;
+use warnings::register;
 our(@ISA, @EXPORT, $VERSION);
 
 use Carp;
@@ -167,8 +168,8 @@ sub struct {
     $cnt = 0;
     foreach $name (@methods){
         if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
-            carp "function '$name' already defined, overrides struct accessor method"
-                if $^W;
+            warnings::warn "function '$name' already defined, overrides struct accessor method"
+                if warnings::enabled();
         }
         else {
             $pre = $pst = $cmt = $sel = '';
diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm
index 580ca39785..64a03a284b 100644
--- a/lib/I18N/Collate.pm
+++ b/lib/I18N/Collate.pm
@@ -108,6 +108,7 @@ European character set.
 # ---
 
 use POSIX qw(strxfrm LC_COLLATE);
+use warnings::register;
 
 require Exporter;
 
@@ -123,9 +124,9 @@ cmp		collate_cmp
 sub new {
   my $new = $_[1];
 
-  if ($^W && $] >= 5.003_06) {
+  if (warnings::enabled() && $] >= 5.003_06) {
     unless ($please_use_I18N_Collate_even_if_deprecated) {
-      warn <<___EOD___;
+      warnings::warn <<___EOD___;
 ***
 
   WARNING: starting from the Perl version 5.003_06
diff --git a/lib/Tie/Handle.pm b/lib/Tie/Handle.pm
index cbac73535d..588ecead89 100644
--- a/lib/Tie/Handle.pm
+++ b/lib/Tie/Handle.pm
@@ -108,6 +108,7 @@ The L<perltie> section contains an example of tying handles.
 =cut
 
 use Carp;
+use warnings::register;
 
 sub new {
     my $pkg = shift;
@@ -119,8 +120,8 @@ sub new {
 sub TIEHANDLE {
     my $pkg = shift;
     if (defined &{"{$pkg}::new"}) {
-	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
-	    if $^W;
+	warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
+	    if warnings::enabled();
 	$pkg->new(@_);
     }
     else {
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 928b798e45..c6ec3d4f5c 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -102,6 +102,7 @@ good working examples.
 =cut
 
 use Carp;
+use warnings::register;
 
 sub new {
     my $pkg = shift;
@@ -113,8 +114,8 @@ sub new {
 sub TIEHASH {
     my $pkg = shift;
     if (defined &{"${pkg}::new"}) {
-	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
-	    if $^W;
+	warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
+	    if warnings::enabled();
 	$pkg->new(@_);
     }
     else {
diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 1e2caee379..0c6759006f 100644
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -79,6 +79,7 @@ process IDs with priority.
 =cut
 
 use Carp;
+use warnings::register;
 
 sub new {
     my $pkg = shift;
@@ -90,8 +91,8 @@ sub new {
 sub TIESCALAR {
     my $pkg = shift;
     if (defined &{"{$pkg}::new"}) {
-	carp "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
-	    if $^W;
+	warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
+	    if warnings::enabled();
 	$pkg->new(@_);
     }
     else {
diff --git a/lib/constant.pm b/lib/constant.pm
index b4fcd421ac..72ad793653 100644
--- a/lib/constant.pm
+++ b/lib/constant.pm
@@ -2,9 +2,10 @@ package constant;
 
 use strict;
 use 5.005_64;
+use warnings::register;
 
 our($VERSION, %declared);
-$VERSION = '1.01';
+$VERSION = '1.02';
 
 #=======================================================================
 
@@ -51,18 +52,17 @@ sub import {
     # Maybe the name is tolerable
     } elsif ($name =~ /^[A-Za-z_]\w*\z/) {
 	# Then we'll warn only if you've asked for warnings
-	if ($^W) {
-	    require Carp;
+	if (warnings::enabled()) {
 	    if ($keywords{$name}) {
-		Carp::carp("Constant name '$name' is a Perl keyword");
+		warnings::warn("Constant name '$name' is a Perl keyword");
 	    } elsif ($forced_into_main{$name}) {
-		Carp::carp("Constant name '$name' is " .
+		warnings::warn("Constant name '$name' is " .
 		    "forced into package main::");
 	    } else {
 		# Catch-all - what did I miss? If you get this error,
 		# please let me know what your constant's name was.
 		# Write to <rootbeer@redcat.com>. Thanks!
-		Carp::carp("Constant name '$name' has unknown problems");
+		warnings::warn("Constant name '$name' has unknown problems");
 	    }
 	}
 
diff --git a/lib/syslog.pl b/lib/syslog.pl
index 9e03399e4d..70c439b9ae 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -29,10 +29,12 @@
 
 package syslog;
 
+use warnings::register;
+
 $host = 'localhost' unless $host;	# set $syslog'host to change
 
-if ($] >= 5) {
-    warn "You should 'use Sys::Syslog' instead; continuing" # if $^W
+if ($] >= 5 && warnings::enabled()) {
+    warnings::warn "You should 'use Sys::Syslog' instead; continuing";
 } 
 
 require 'syslog.ph';
diff --git a/lib/vars.pm b/lib/vars.pm
index 6ae5373f89..bde0b2a0e8 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -8,6 +8,7 @@ require 5.002;
 # if Carp hasn't been loaded in earlier compile time. :-(
 # We'll let those bugs get found on the development track.
 require Carp if $] < 5.00450;
+use warnings::register();
 
 sub import {
     my $callpack = caller;
@@ -22,9 +23,8 @@ sub import {
 	    } elsif ($sym =~ /^\w+[[{].*[]}]$/) {
 		require Carp;
 		Carp::croak("Can't declare individual elements of hash or array");
-	    } elsif ($^W and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
-		require Carp;
-		Carp::carp("No need to declare built-in vars");
+	    } elsif (warnings::enabled() and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
+		warnings::warn("No need to declare built-in vars");
 	    }
 	}
         *{"${callpack}::$sym"} =
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 11fd5b0718..11558d50d4 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -17,7 +17,12 @@ warnings - Perl pragma to control optional warnings
     use warnings "all";
     no warnings "all";
 
-    if (warnings::enabled("void") {
+    use warnings::register;
+    if (warnings::enabled()) {
+        warnings::warn("some warning");
+    }
+
+    if (warnings::enabled("void")) {
         warnings::warn("void", "some warning");
     }
 
@@ -26,23 +31,33 @@ warnings - Perl pragma to control optional warnings
 If no import list is supplied, all possible warnings are either enabled
 or disabled.
 
-Two functions are provided to assist module authors.
+A number of functions are provided to assist module authors. 
 
 =over 4
 
-=item warnings::enabled($category)
+=item use warnings::register
+
+Creates a new warnings category which has the same name as the module
+where the call to the pragma is used.
 
-Returns TRUE if the warnings category in C<$category> is enabled in the
-calling module. Otherwise returns FALSE.
+=item warnings::enabled([$category])
 
+Returns TRUE if the warnings category C<$category> is enabled in the
+calling module.  Otherwise returns FALSE.
 
-=item warnings::warn($category, $message)
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
+
+=item warnings::warn([$category,] $message)
 
 If the calling module has I<not> set C<$category> to "FATAL", print
 C<$message> to STDERR.
 If the calling module has set C<$category> to "FATAL", print C<$message>
 STDERR then die.
 
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
+
 =back
 
 See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
@@ -51,107 +66,161 @@ See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
 
 use Carp ;
 
+%Offsets = (
+    'all'		=> 0,
+    'chmod'		=> 2,
+    'closure'		=> 4,
+    'exiting'		=> 6,
+    'glob'		=> 8,
+    'io'		=> 10,
+    'closed'		=> 12,
+    'exec'		=> 14,
+    'newline'		=> 16,
+    'pipe'		=> 18,
+    'unopened'		=> 20,
+    'misc'		=> 22,
+    'numeric'		=> 24,
+    'once'		=> 26,
+    'overflow'		=> 28,
+    'pack'		=> 30,
+    'portable'		=> 32,
+    'recursion'		=> 34,
+    'redefine'		=> 36,
+    'regexp'		=> 38,
+    'severe'		=> 40,
+    'debugging'		=> 42,
+    'inplace'		=> 44,
+    'internal'		=> 46,
+    'malloc'		=> 48,
+    'signal'		=> 50,
+    'substr'		=> 52,
+    'syntax'		=> 54,
+    'ambiguous'		=> 56,
+    'bareword'		=> 58,
+    'deprecated'	=> 60,
+    'digit'		=> 62,
+    'parenthesis'	=> 64,
+    'precedence'	=> 66,
+    'printf'		=> 68,
+    'prototype'		=> 70,
+    'qw'		=> 72,
+    'reserved'		=> 74,
+    'semicolon'		=> 76,
+    'taint'		=> 78,
+    'umask'		=> 80,
+    'uninitialized'	=> 82,
+    'unpack'		=> 84,
+    'untie'		=> 86,
+    'utf8'		=> 88,
+    'void'		=> 90,
+    'y2k'		=> 92,
+  );
+
 %Bits = (
-    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
-    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
-    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
-    'chmod'		=> "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
-    'closed'		=> "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
-    'closure'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'		=> "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
-    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
-    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
-    'exec'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'exiting'		=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'glob'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'inplace'		=> "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
-    'internal'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
-    'io'		=> "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
-    'malloc'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
-    'misc'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'newline'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'numeric'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'once'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'overflow'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'pack'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
-    'pipe'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'portable'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
-    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
-    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
-    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
-    'recursion'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'redefine'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'regexp'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
-    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
-    'severe'		=> "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
-    'signal'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
-    'substr'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
-    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
-    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
-    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
-    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
-    'unopened'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
-    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
-    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
-    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
-    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+    'chmod'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'closed'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'glob'		=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
+    'internal'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+    'io'		=> "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+    'misc'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'newline'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'numeric'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'once'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'overflow'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'pack'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'portable'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'redefine'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'regexp'		=> "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+    'unopened'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
   );
 
 %DeadBits = (
-    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
-    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
-    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
-    'chmod'		=> "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
-    'closed'		=> "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
-    'closure'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'		=> "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
-    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
-    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
-    'exec'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'exiting'		=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'glob'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'inplace'		=> "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
-    'internal'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
-    'io'		=> "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
-    'malloc'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
-    'misc'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'newline'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'numeric'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'once'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'overflow'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'pack'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
-    'pipe'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'portable'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
-    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
-    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
-    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
-    'recursion'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'redefine'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'regexp'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
-    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
-    'severe'		=> "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
-    'signal'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
-    'substr'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
-    'syntax'		=> "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
-    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
-    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
-    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
-    'unopened'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
-    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
-    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
-    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
-    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+    'chmod'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'closed'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'glob'		=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
+    'internal'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+    'io'		=> "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+    'misc'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'newline'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'numeric'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'once'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'overflow'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'pack'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'portable'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'redefine'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'regexp'		=> "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+    'unopened'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
   );
 
-$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
+$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
+$LAST_BIT = 94 ;
+$BYTES    = 12 ;
+
+$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
 sub bits {
     my $mask ;
@@ -161,12 +230,12 @@ sub bits {
 	if  ($word eq 'FATAL') {
 	    $fatal = 1;
 	}
-	else {
-	    if ($catmask = $Bits{$word}) {
-		$mask |= $catmask ;
-		$mask |= $DeadBits{$word} if $fatal ;
-	    }
+	elsif ($catmask = $Bits{$word}) {
+	    $mask |= $catmask ;
+	    $mask |= $DeadBits{$word} if $fatal ;
 	}
+	else
+          { croak("unknown warnings category '$word'")}  
     }
 
     return $mask ;
@@ -179,38 +248,70 @@ sub import {
 
 sub unimport {
     shift;
-    ${^WARNING_BITS} &= ~ bits(@_ ? @_ : 'all') ;
+    my $mask = ${^WARNING_BITS} ;
+    if (vec($mask, $Offsets{'all'}, 1)) {
+        $mask = $Bits{'all'} ;
+        $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
+    }
+    ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
 }
 
 sub enabled
 {
-    # If no parameters, check for any lexical warnings enabled
-    # in the users scope.
+    croak("Usage: warnings::enabled([category])")
+	unless @_ == 1 || @_ == 0 ;
+    local $Carp::CarpLevel = 1 ;
+    my $category ;
+    my $offset ;
     my $callers_bitmask = (caller(1))[9] ; 
-    return ($callers_bitmask ne $NONE) if @_ == 0 ;
-
-    # otherwise check for the category supplied.
-    my $category = shift ;
-    return 0
-	unless $Bits{$category} ;
     return 0 unless defined $callers_bitmask ;
-    return 1
-	if ($callers_bitmask & $Bits{$category}) ne $NONE ;
-   
-    return 0 ; 
+
+
+    if (@_) {
+        # check the category supplied.
+        $category = shift ;
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset;
+    }
+    else {
+        $category = (caller(0))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
+
+    return vec($callers_bitmask, $offset, 1) ||
+           vec($callers_bitmask, $Offsets{'all'}, 1) ;
 }
 
+
 sub warn
 {
-    croak "Usage: warnings::warn('category', 'message')"
-	unless @_ == 2 ;
-    my $category = shift ;
-    my $message = shift ;
+    croak("Usage: warnings::warn([category,] 'message')")
+	unless @_ == 2 || @_ == 1 ;
     local $Carp::CarpLevel = 1 ;
+    my $category ;
+    my $offset ;
     my $callers_bitmask = (caller(1))[9] ; 
+
+    if (@_ == 2) {
+        $category = shift ;
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset ;
+    }
+    else {
+        $category = (caller(0))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
+
+    my $message = shift ;
     croak($message) 
-	if defined $callers_bitmask &&
-           ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+	if vec($callers_bitmask, $offset+1, 1) ||
+	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
     carp($message) ;
 }
 
diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm
new file mode 100644
index 0000000000..da6be97952
--- /dev/null
+++ b/lib/warnings/register.pm
@@ -0,0 +1,30 @@
+package warnings::register ;
+
+require warnings ;
+
+sub mkMask
+{
+    my ($bit) = @_ ;
+    my $mask = "" ;
+
+    vec($mask, $bit, 1) = 1 ;
+    return $mask ;
+}
+
+sub import
+{
+    shift ;
+    my $package = (caller(0))[0] ;
+    if (! defined $warnings::Bits{$package}) {
+        $warnings::Bits{$package}     = mkMask($warnings::LAST_BIT) ;
+        vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1 ;
+        $warnings::Offsets{$package}  = $warnings::LAST_BIT ++ ;
+	foreach my $k (keys %warnings::Bits) {
+	    vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0 ;
+	}
+        $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT);
+        vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1 ;
+    }
+}
+
+1 ;
diff --git a/mg.c b/mg.c
index 96d268bfc7..8bdb2ee862 100644
--- a/mg.c
+++ b/mg.c
@@ -565,17 +565,18 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	if (*(mg->mg_ptr+1) == '\0')
 	    sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
 	else if (strEQ(mg->mg_ptr, "\027ARNING_BITS")) {
-	    if (PL_compiling.cop_warnings == WARN_NONE ||
-	        PL_compiling.cop_warnings == WARN_STD)
+	    if (PL_compiling.cop_warnings == pWARN_NONE ||
+	        PL_compiling.cop_warnings == pWARN_STD)
 	    {
 	        sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
             }
-            else if (PL_compiling.cop_warnings == WARN_ALL) {
+            else if (PL_compiling.cop_warnings == pWARN_ALL) {
 	        sv_setpvn(sv, WARN_ALLstring, WARNsize) ;
 	    }    
             else {
 	        sv_setsv(sv, PL_compiling.cop_warnings);
 	    }    
+	    SvPOK_only(sv);
 	}
 	else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS"))
 	    sv_setiv(sv, (IV)PL_widesyscalls);
@@ -1715,23 +1716,31 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
 		if (!SvPOK(sv) && PL_localizing) {
 	            sv_setpvn(sv, WARN_NONEstring, WARNsize);
-	            PL_compiling.cop_warnings = WARN_NONE;
+	            PL_compiling.cop_warnings = pWARN_NONE;
 		    break;
 		}
-                if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize)) {
-	            PL_compiling.cop_warnings = WARN_ALL;
+                if (isWARN_on(sv, WARN_ALL)) {
+	            PL_compiling.cop_warnings = pWARN_ALL;
 	            PL_dowarn |= G_WARN_ONCE ;
 	        }	
-	        else if (memEQ(SvPVX(sv), WARN_NONEstring, WARNsize))
-	            PL_compiling.cop_warnings = WARN_NONE;
-                else {
-	            if (specialWARN(PL_compiling.cop_warnings))
-		        PL_compiling.cop_warnings = newSVsv(sv) ;
-	            else
-	                sv_setsv(PL_compiling.cop_warnings, sv);
-	            if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
-	                PL_dowarn |= G_WARN_ONCE ;
-	        }
+		else {
+		    int i ;
+		    int accumulate = 0 ;
+		    int len ;
+		    char * ptr = (char*)SvPV(sv, len) ;
+		    for (i = 0 ; i < len ; ++i) 
+		        accumulate += ptr[i] ;
+		    if (!accumulate)
+	                PL_compiling.cop_warnings = pWARN_NONE;
+                    else {
+	                if (specialWARN(PL_compiling.cop_warnings))
+		            PL_compiling.cop_warnings = newSVsv(sv) ;
+	                else
+	                    sv_setsv(PL_compiling.cop_warnings, sv);
+	                if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
+	                    PL_dowarn |= G_WARN_ONCE ;
+	            }
+		}
 	    }
 	}
 	else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS"))
diff --git a/perl.c b/perl.c
index 3569e93b06..e517451a02 100644
--- a/perl.c
+++ b/perl.c
@@ -2233,12 +2233,12 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
 	return s;
     case 'W':
 	PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; 
-	PL_compiling.cop_warnings = WARN_ALL ;
+	PL_compiling.cop_warnings = pWARN_ALL ;
 	s++;
 	return s;
     case 'X':
 	PL_dowarn = G_WARN_ALL_OFF; 
-	PL_compiling.cop_warnings = WARN_NONE ;
+	PL_compiling.cop_warnings = pWARN_NONE ;
 	s++;
 	return s;
     case '*':
diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index af1a910334..cee1687537 100644
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -339,20 +339,49 @@ fatal error.
 
 =head2 Reporting Warnings from a Module
 
-The C<warnings> pragma provides two functions, namely C<warnings::enabled>
-and C<warnings::warn>, that are useful for module authors. They are
-used when you want to report a module-specific warning, but only when
-the calling module has enabled warnings via the C<warnings> pragma.
+The C<warnings> pragma provides a number of functions that are useful for
+module authors. These are used when you want to report a module-specific
+warning when the calling module has enabled warnings via the C<warnings>
+pragma.
 
-Consider the module C<abc> below.
+Consider the module C<MyMod::Abc> below.
 
-    package abc;
+    package MyMod::Abc;
 
-    sub open
-    {
+    use warnings::register;
+
+    sub open {
+        my $path = shift ;
+        if (warnings::enabled() && $path !~ m#^/#) {
+            warnings::warn("changing relative path to /tmp/");
+            $path = "/tmp/$path" ; 
+        }
+    }
+
+    1 ;
+
+The call to C<warnings::register> will create a new warnings category
+called "MyMod::abc", i.e. the new category name matches the module
+name. The C<open> function in the module will display a warning message
+if it gets given a relative path as a parameter. This warnings will only
+be displayed if the code that uses C<MyMod::Abc> has actually enabled
+them with the C<warnings> pragma like below.
+
+    use MyMod::Abc;
+    use warnings 'MyMod::Abc';
+    ...
+    abc::open("../fred.txt");
+
+It is also possible to test whether the pre-defined warnings categories are
+set in the calling module with the C<warnings::enabled> function. Consider
+this snippet of code:
+
+    package MyMod::Abc;
+
+    sub open {
         if (warnings::enabled("deprecated")) {
             warnings::warn("deprecated", 
-                           "abc::open is deprecated. Use abc:new") ;
+                           "open is deprecated, use new instead") ;
         }
         new(@_) ;
     }
@@ -366,21 +395,21 @@ display a warning message whenever the calling module has (at least) the
 "deprecated" warnings category enabled. Something like this, say.
 
     use warnings 'deprecated';
-    use abc;
+    use MyMod::Abc;
     ...
-    abc::open($filename) ;
-
+    MyMod::Abc::open($filename) ;
 
-If the calling module has escalated the "deprecated" warnings category
-into a fatal error like this:
+The C<warnings::warn> function should be used to actually display the
+warnings message. This is because they can make use of the feature that
+allows warnings to be escalated into fatal errors. So in this case
 
-    use warnings 'FATAL deprecated';
-    use abc;
+    use MyMod::Abc;
+    use warnings FATAL => 'MyMod::Abc';
     ...
-    abc::open($filename) ;
+    MyMod::Abc::open('../fred.txt');
 
-then C<warnings::warn> will detect this and die after displaying the
-warning message.
+the C<warnings::warn> function will detect this and die after
+displaying the warning message.
 
 =head1 TODO
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 4917b02c98..cee753a125 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1562,9 +1562,9 @@ PP(pp_caller)
     {
 	SV * mask ;
 	SV * old_warnings = cx->blk_oldcop->cop_warnings ;
-	if  (old_warnings == WARN_NONE || old_warnings == WARN_STD)
+	if  (old_warnings == pWARN_NONE || old_warnings == pWARN_STD)
             mask = newSVpvn(WARN_NONEstring, WARNsize) ;
-        else if (old_warnings == WARN_ALL)
+        else if (old_warnings == pWARN_ALL)
             mask = newSVpvn(WARN_ALLstring, WARNsize) ;
         else
             mask = newSVsv(old_warnings);
@@ -3167,11 +3167,11 @@ PP(pp_require)
     PL_hints = 0;
     SAVESPTR(PL_compiling.cop_warnings);
     if (PL_dowarn & G_WARN_ALL_ON)
-        PL_compiling.cop_warnings = WARN_ALL ;
+        PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
-        PL_compiling.cop_warnings = WARN_NONE ;
+        PL_compiling.cop_warnings = pWARN_NONE ;
     else 
-        PL_compiling.cop_warnings = WARN_STD ;
+        PL_compiling.cop_warnings = pWARN_STD ;
 
     if (filter_sub || filter_child_proc) {
 	SV *datasv = filter_add(run_user_filter, Nullsv);
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
diff --git a/warnings.h b/warnings.h
index 31942e1e66..a2bcaeb43e 100644
--- a/warnings.h
+++ b/warnings.h
@@ -16,97 +16,98 @@
 #define G_WARN_ONCE		8	/* set if 'once' ever enabled */
 #define G_WARN_ALL_MASK		(G_WARN_ALL_ON|G_WARN_ALL_OFF)
 
-#define WARN_STD		Nullsv
-#define WARN_ALL		(Nullsv+1)	/* use warnings 'all' */
-#define WARN_NONE		(Nullsv+2)	/* no  warnings 'all' */
+#define pWARN_STD		Nullsv
+#define pWARN_ALL		(Nullsv+1)	/* use warnings 'all' */
+#define pWARN_NONE		(Nullsv+2)	/* no  warnings 'all' */
 
-#define specialWARN(x)		((x) == WARN_STD || (x) == WARN_ALL ||	\
-				 (x) == WARN_NONE)
+#define specialWARN(x)		((x) == pWARN_STD || (x) == pWARN_ALL ||	\
+				 (x) == pWARN_NONE)
 
 #define ckDEAD(x)							\
 	   ( ! specialWARN(PL_curcop->cop_warnings) &&			\
 	    IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
 
 #define ckWARN(x)							\
-	( (PL_curcop->cop_warnings != WARN_STD &&			\
-	   PL_curcop->cop_warnings != WARN_NONE &&			\
-	      (PL_curcop->cop_warnings == WARN_ALL ||			\
+	( (PL_curcop->cop_warnings != pWARN_STD &&			\
+	   PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
 	       IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )		\
-	  || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) )
+	  || (PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
 
 #define ckWARN2(x,y)							\
-	  ( (PL_curcop->cop_warnings != WARN_STD  &&			\
-	     PL_curcop->cop_warnings != WARN_NONE &&			\
-	      (PL_curcop->cop_warnings == WARN_ALL ||			\
+	  ( (PL_curcop->cop_warnings != pWARN_STD  &&			\
+	     PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
 	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
 	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) 		\
-	    ||	(PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) )
+	    ||	(PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
 
 #define ckWARN_d(x)							\
-	  (PL_curcop->cop_warnings == WARN_STD ||			\
-	   PL_curcop->cop_warnings == WARN_ALL ||			\
-	     (PL_curcop->cop_warnings != WARN_NONE &&			\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
 	      IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )
 
 #define ckWARN2_d(x,y)							\
-	  (PL_curcop->cop_warnings == WARN_STD ||			\
-	   PL_curcop->cop_warnings == WARN_ALL ||			\
-	     (PL_curcop->cop_warnings != WARN_NONE &&			\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
 	        (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
 	         IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) )
 
 
-#define isLEXWARN_on 	(PL_curcop->cop_warnings != WARN_STD)
-#define isLEXWARN_off	(PL_curcop->cop_warnings == WARN_STD)
+#define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)
 #define isWARN_ONCE	(PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
 #define isWARN_on(c,x)	(IsSet(SvPVX(c), 2*(x)))
 
-#define WARN_CHMOD		0
-#define WARN_CLOSURE		1
-#define WARN_EXITING		2
-#define WARN_GLOB		3
-#define WARN_IO			4
-#define WARN_CLOSED		5
-#define WARN_EXEC		6
-#define WARN_NEWLINE		7
-#define WARN_PIPE		8
-#define WARN_UNOPENED		9
-#define WARN_MISC		10
-#define WARN_NUMERIC		11
-#define WARN_ONCE		12
-#define WARN_OVERFLOW		13
-#define WARN_PACK		14
-#define WARN_PORTABLE		15
-#define WARN_RECURSION		16
-#define WARN_REDEFINE		17
-#define WARN_REGEXP		18
-#define WARN_SEVERE		19
-#define WARN_DEBUGGING		20
-#define WARN_INPLACE		21
-#define WARN_INTERNAL		22
-#define WARN_MALLOC		23
-#define WARN_SIGNAL		24
-#define WARN_SUBSTR		25
-#define WARN_SYNTAX		26
-#define WARN_AMBIGUOUS		27
-#define WARN_BAREWORD		28
-#define WARN_DEPRECATED		29
-#define WARN_DIGIT		30
-#define WARN_PARENTHESIS	31
-#define WARN_PRECEDENCE		32
-#define WARN_PRINTF		33
-#define WARN_PROTOTYPE		34
-#define WARN_QW			35
-#define WARN_RESERVED		36
-#define WARN_SEMICOLON		37
-#define WARN_TAINT		38
-#define WARN_UMASK		39
-#define WARN_UNINITIALIZED	40
-#define WARN_UNPACK		41
-#define WARN_UNTIE		42
-#define WARN_UTF8		43
-#define WARN_VOID		44
-#define WARN_Y2K		45
+#define WARN_ALL		0
+#define WARN_CHMOD		1
+#define WARN_CLOSURE		2
+#define WARN_EXITING		3
+#define WARN_GLOB		4
+#define WARN_IO			5
+#define WARN_CLOSED		6
+#define WARN_EXEC		7
+#define WARN_NEWLINE		8
+#define WARN_PIPE		9
+#define WARN_UNOPENED		10
+#define WARN_MISC		11
+#define WARN_NUMERIC		12
+#define WARN_ONCE		13
+#define WARN_OVERFLOW		14
+#define WARN_PACK		15
+#define WARN_PORTABLE		16
+#define WARN_RECURSION		17
+#define WARN_REDEFINE		18
+#define WARN_REGEXP		19
+#define WARN_SEVERE		20
+#define WARN_DEBUGGING		21
+#define WARN_INPLACE		22
+#define WARN_INTERNAL		23
+#define WARN_MALLOC		24
+#define WARN_SIGNAL		25
+#define WARN_SUBSTR		26
+#define WARN_SYNTAX		27
+#define WARN_AMBIGUOUS		28
+#define WARN_BAREWORD		29
+#define WARN_DEPRECATED		30
+#define WARN_DIGIT		31
+#define WARN_PARENTHESIS	32
+#define WARN_PRECEDENCE		33
+#define WARN_PRINTF		34
+#define WARN_PROTOTYPE		35
+#define WARN_QW			36
+#define WARN_RESERVED		37
+#define WARN_SEMICOLON		38
+#define WARN_TAINT		39
+#define WARN_UMASK		40
+#define WARN_UNINITIALIZED	41
+#define WARN_UNPACK		42
+#define WARN_UNTIE		43
+#define WARN_UTF8		44
+#define WARN_VOID		45
+#define WARN_Y2K		46
 
 #define WARNsize		12
 #define WARN_ALLstring		"\125\125\125\125\125\125\125\125\125\125\125\125"
diff --git a/warnings.pl b/warnings.pl
index 0952305b28..61602d5608 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -9,6 +9,8 @@ sub DEFAULT_ON  () { 1 }
 sub DEFAULT_OFF () { 2 }
 
 my $tree = {
+
+'all' => {
        	'io'  		=> { 	'pipe' 		=> DEFAULT_OFF,
        				'unopened'	=> DEFAULT_OFF,
        				'closed'	=> DEFAULT_OFF,
@@ -56,7 +58,8 @@ my $tree = {
        	'pack'		=> DEFAULT_OFF,
        	'unpack'	=> DEFAULT_OFF,
        	 #'default'	=> DEFAULT_ON,
-	} ;
+  	}
+} ;
 
 
 ###########################################################################
@@ -70,7 +73,7 @@ sub tab {
 
 my %list ;
 my %Value ;
-my $index = 0 ;
+my $index ;
 
 sub walk
 {
@@ -161,7 +164,7 @@ sub mkHex
 
 if (@ARGV && $ARGV[0] eq "tree")
 {
-    print "  all -+\n" ;
+    #print "  all -+\n" ;
     printTree($tree, "   ", 4) ;
     exit ;
 }
@@ -190,56 +193,59 @@ print WARN <<'EOM' ;
 #define G_WARN_ONCE		8	/* set if 'once' ever enabled */
 #define G_WARN_ALL_MASK		(G_WARN_ALL_ON|G_WARN_ALL_OFF)
 
-#define WARN_STD		Nullsv
-#define WARN_ALL		(Nullsv+1)	/* use warnings 'all' */
-#define WARN_NONE		(Nullsv+2)	/* no  warnings 'all' */
+#define pWARN_STD		Nullsv
+#define pWARN_ALL		(Nullsv+1)	/* use warnings 'all' */
+#define pWARN_NONE		(Nullsv+2)	/* no  warnings 'all' */
 
-#define specialWARN(x)		((x) == WARN_STD || (x) == WARN_ALL ||	\
-				 (x) == WARN_NONE)
+#define specialWARN(x)		((x) == pWARN_STD || (x) == pWARN_ALL ||	\
+				 (x) == pWARN_NONE)
 
 #define ckDEAD(x)							\
 	   ( ! specialWARN(PL_curcop->cop_warnings) &&			\
 	    IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
 
 #define ckWARN(x)							\
-	( (PL_curcop->cop_warnings != WARN_STD &&			\
-	   PL_curcop->cop_warnings != WARN_NONE &&			\
-	      (PL_curcop->cop_warnings == WARN_ALL ||			\
+	( (PL_curcop->cop_warnings != pWARN_STD &&			\
+	   PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
 	       IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )		\
-	  || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) )
+	  || (PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
 
 #define ckWARN2(x,y)							\
-	  ( (PL_curcop->cop_warnings != WARN_STD  &&			\
-	     PL_curcop->cop_warnings != WARN_NONE &&			\
-	      (PL_curcop->cop_warnings == WARN_ALL ||			\
+	  ( (PL_curcop->cop_warnings != pWARN_STD  &&			\
+	     PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
 	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
 	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) 		\
-	    ||	(PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) )
+	    ||	(PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
 
 #define ckWARN_d(x)							\
-	  (PL_curcop->cop_warnings == WARN_STD ||			\
-	   PL_curcop->cop_warnings == WARN_ALL ||			\
-	     (PL_curcop->cop_warnings != WARN_NONE &&			\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
 	      IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )
 
 #define ckWARN2_d(x,y)							\
-	  (PL_curcop->cop_warnings == WARN_STD ||			\
-	   PL_curcop->cop_warnings == WARN_ALL ||			\
-	     (PL_curcop->cop_warnings != WARN_NONE &&			\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
 	        (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
 	         IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) )
 
 
-#define isLEXWARN_on 	(PL_curcop->cop_warnings != WARN_STD)
-#define isLEXWARN_off	(PL_curcop->cop_warnings == WARN_STD)
+#define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)
 #define isWARN_ONCE	(PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
 #define isWARN_on(c,x)	(IsSet(SvPVX(c), 2*(x)))
 
 EOM
 
+my $offset = 0 ;
+
+$index = $offset ;
+#@{ $list{"all"} } = walk ($tree) ;
+walk ($tree) ;
 
-$index = 0 ;
-@{ $list{"all"} } = walk ($tree) ;
 
 $index *= 2 ;
 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
@@ -268,7 +274,19 @@ while (<DATA>) {
     print PM $_ ;
 }
 
-$list{'all'} = [ 0 .. 8 * ($warn_size/2) - 1 ] ;
+#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
+
+#my %Keys = map {lc $Value{$_}, $_} keys %Value ;
+
+print PM "%Offsets = (\n" ;
+foreach my $k (sort { $a <=> $b } keys %Value) {
+    my $v = lc $Value{$k} ;
+    $k *= 2 ;
+    print PM tab(4, "    '$v'"), "=> $k,\n" ;
+}
+
+print PM "  );\n\n" ;
+
 print PM "%Bits = (\n" ;
 foreach $k (sort keys  %list) {
 
@@ -296,7 +314,9 @@ foreach $k (sort keys  %list) {
 }
 
 print PM "  );\n\n" ;
-print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
+print PM '$NONE     = "', ('\0' x $warn_size) , "\";\n" ;
+print PM '$LAST_BIT = ' . "$index ;\n" ;
+print PM '$BYTES    = ' . "$warn_size ;\n" ;
 while (<DATA>) {
     print PM $_ ;
 }
@@ -323,7 +343,12 @@ warnings - Perl pragma to control optional warnings
     use warnings "all";
     no warnings "all";
 
-    if (warnings::enabled("void") {
+    use warnings::register;
+    if (warnings::enabled()) {
+        warnings::warn("some warning");
+    }
+
+    if (warnings::enabled("void")) {
         warnings::warn("void", "some warning");
     }
 
@@ -332,23 +357,33 @@ warnings - Perl pragma to control optional warnings
 If no import list is supplied, all possible warnings are either enabled
 or disabled.
 
-Two functions are provided to assist module authors.
+A number of functions are provided to assist module authors. 
 
 =over 4
 
-=item warnings::enabled($category)
+=item use warnings::register
+
+Creates a new warnings category which has the same name as the module
+where the call to the pragma is used.
+
+=item warnings::enabled([$category])
 
-Returns TRUE if the warnings category in C<$category> is enabled in the
-calling module. Otherwise returns FALSE.
+Returns TRUE if the warnings category C<$category> is enabled in the
+calling module.  Otherwise returns FALSE.
 
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
 
-=item warnings::warn($category, $message)
+=item warnings::warn([$category,] $message)
 
 If the calling module has I<not> set C<$category> to "FATAL", print
 C<$message> to STDERR.
 If the calling module has set C<$category> to "FATAL", print C<$message>
 STDERR then die.
 
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
+
 =back
 
 See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
@@ -359,6 +394,8 @@ use Carp ;
 
 KEYWORDS
 
+$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
+
 sub bits {
     my $mask ;
     my $catmask ;
@@ -367,12 +404,12 @@ sub bits {
 	if  ($word eq 'FATAL') {
 	    $fatal = 1;
 	}
-	else {
-	    if ($catmask = $Bits{$word}) {
-		$mask |= $catmask ;
-		$mask |= $DeadBits{$word} if $fatal ;
-	    }
+	elsif ($catmask = $Bits{$word}) {
+	    $mask |= $catmask ;
+	    $mask |= $DeadBits{$word} if $fatal ;
 	}
+	else
+          { croak("unknown warnings category '$word'")}  
     }
 
     return $mask ;
@@ -385,38 +422,70 @@ sub import {
 
 sub unimport {
     shift;
-    ${^WARNING_BITS} &= ~ bits(@_ ? @_ : 'all') ;
+    my $mask = ${^WARNING_BITS} ;
+    if (vec($mask, $Offsets{'all'}, 1)) {
+        $mask = $Bits{'all'} ;
+        $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
+    }
+    ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
 }
 
 sub enabled
 {
-    # If no parameters, check for any lexical warnings enabled
-    # in the users scope.
+    croak("Usage: warnings::enabled([category])")
+	unless @_ == 1 || @_ == 0 ;
+    local $Carp::CarpLevel = 1 ;
+    my $category ;
+    my $offset ;
     my $callers_bitmask = (caller(1))[9] ; 
-    return ($callers_bitmask ne $NONE) if @_ == 0 ;
-
-    # otherwise check for the category supplied.
-    my $category = shift ;
-    return 0
-	unless $Bits{$category} ;
     return 0 unless defined $callers_bitmask ;
-    return 1
-	if ($callers_bitmask & $Bits{$category}) ne $NONE ;
-   
-    return 0 ; 
+
+
+    if (@_) {
+        # check the category supplied.
+        $category = shift ;
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset;
+    }
+    else {
+        $category = (caller(0))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
+
+    return vec($callers_bitmask, $offset, 1) ||
+           vec($callers_bitmask, $Offsets{'all'}, 1) ;
 }
 
+
 sub warn
 {
-    croak "Usage: warnings::warn('category', 'message')"
-	unless @_ == 2 ;
-    my $category = shift ;
-    my $message = shift ;
+    croak("Usage: warnings::warn([category,] 'message')")
+	unless @_ == 2 || @_ == 1 ;
     local $Carp::CarpLevel = 1 ;
+    my $category ;
+    my $offset ;
     my $callers_bitmask = (caller(1))[9] ; 
+
+    if (@_ == 2) {
+        $category = shift ;
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset ;
+    }
+    else {
+        $category = (caller(0))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
+
+    my $message = shift ;
     croak($message) 
-	if defined $callers_bitmask &&
-           ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+	if vec($callers_bitmask, $offset+1, 1) ||
+	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
     carp($message) ;
 }