X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warnings.pl;h=e7659b93742194344739b07f2633bc48b2c63212;hb=612cfdf27c84f3ca36e00ec7f6925d0a5223e483;hp=7feccb57516ba79984d94ee26372d225d5eac27c;hpb=4f527b719ae8907622f7dc49e1c381136e69bb59;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/warnings.pl b/warnings.pl
index 7feccb5..e7659b9 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -49,7 +49,6 @@ my $tree = {
        	'misc'		=> [ 5.008, DEFAULT_OFF],
        	'regexp'	=> [ 5.008, DEFAULT_OFF],
        	'glob'		=> [ 5.008, DEFAULT_OFF],
-       	'y2k'		=> [ 5.008, DEFAULT_OFF],
        	'untie'		=> [ 5.008, DEFAULT_OFF],
 	'substr'	=> [ 5.008, DEFAULT_OFF],
 	'taint'		=> [ 5.008, DEFAULT_OFF],
@@ -253,7 +252,9 @@ if (@ARGV && $ARGV[0] eq "tree")
 unlink "warnings.h";
 unlink "lib/warnings.pm";
 open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+binmode WARN;
 open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
+binmode PM;
 
 print WARN <<'EOM' ;
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
@@ -414,7 +415,7 @@ while (<DATA>) {
 #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
 
 $last_ver = 0;
-print PM "our %Offsets : unique = (\n" ;
+print PM "our %Offsets = (\n" ;
 foreach my $k (sort { $a <=> $b } keys %ValueToName) {
     my ($name, $version) = @{ $ValueToName{$k} };
     $name = lc $name;
@@ -430,7 +431,7 @@ foreach my $k (sort { $a <=> $b } keys %ValueToName) {
 
 print PM "  );\n\n" ;
 
-print PM "our %Bits : unique = (\n" ;
+print PM "our %Bits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;
@@ -444,7 +445,7 @@ foreach $k (sort keys  %list) {
 
 print PM "  );\n\n" ;
 
-print PM "our %DeadBits : unique = (\n" ;
+print PM "our %DeadBits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;
@@ -475,7 +476,7 @@ __END__
 
 package warnings;
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 =head1 NAME
 
@@ -600,14 +601,13 @@ See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 
 =cut
 
-use Carp ();
-
 KEYWORDS
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
 sub Croaker
 {
+    require Carp;
     delete $Carp::CarpInternal{'warnings'};
     Carp::croak(@_);
 }
@@ -710,6 +710,8 @@ sub unimport
     ${^WARNING_BITS} = $mask ;
 }
 
+my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
+
 sub __chk
 {
     my $category ;
@@ -719,10 +721,10 @@ sub __chk
     if (@_) {
         # check the category supplied.
         $category = shift ;
-        if (ref $category) {
-            Croaker ("not an object")
-                if $category !~ /^([^=]+)=/ ;
-	    $category = $1 ;
+        if (my $type = ref $category) {
+            Croaker("not an object")
+                if exists $builtin_type{$type};
+	    $category = $type;
             $isobj = 1 ;
         }
         $offset = $Offsets{$category};
@@ -779,6 +781,7 @@ sub warn
 
     my $message = pop ;
     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+    require Carp;
     Carp::croak($message)
 	if vec($callers_bitmask, $offset+1, 1) ||
 	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
@@ -798,6 +801,7 @@ sub warnif
             	(vec($callers_bitmask, $offset, 1) ||
             	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
 
+    require Carp;
     Carp::croak($message)
 	if vec($callers_bitmask, $offset+1, 1) ||
 	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;