X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warnings.pl;h=e5ac703492a1035ff9dbf22efe39950464a9259f;hb=b1e7e56f1e0264e9b11883bf65d50cc9648125ec;hp=138b1db5afb8c9b288df34ba748339d745cb70c1;hpb=918426be7f3660c63cebe082bf8eac82a38bf756;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/warnings.pl b/warnings.pl
index 138b1db..e5ac703 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -47,8 +47,6 @@ my $tree = {
        	'regexp'	=> DEFAULT_OFF,
        	'glob'		=> DEFAULT_OFF,
        	'y2k'		=> DEFAULT_OFF,
-       	'chmod'		=> DEFAULT_OFF,
-       	'umask'		=> DEFAULT_OFF,
        	'untie'		=> DEFAULT_OFF,
 	'substr'	=> DEFAULT_OFF,
 	'taint'		=> DEFAULT_OFF,
@@ -145,9 +143,9 @@ sub printTree
 
 ###########################################################################
 
-sub mkHex
+sub mkHexOct
 {
-    my ($max, @a) = @_ ;
+    my ($f, $max, @a) = @_ ;
     my $mask = "\x00" x $max ;
     my $string = "" ;
 
@@ -155,14 +153,29 @@ sub mkHex
 	vec($mask, $_, 1) = 1 ;
     }
 
-    #$string = unpack("H$max", $mask) ;
-    #$string =~ s/(..)/\x$1/g;
     foreach (unpack("C*", $mask)) {
-	$string .= '\x' . sprintf("%2.2x", $_) ;
+        if ($f eq 'x') {
+            $string .= '\x' . sprintf("%2.2x", $_)
+        }
+        else {
+            $string .= '\\' . sprintf("%o", $_)
+        }
     }
     return $string ;
 }
 
+sub mkHex
+{
+    my($max, @a) = @_;
+    return mkHexOct("x", $max, @a);
+}
+
+sub mkOct
+{
+    my($max, @a) = @_;
+    return mkHexOct("o", $max, @a);
+}
+
 ###########################################################################
 
 if (@ARGV && $ARGV[0] eq "tree")
@@ -224,6 +237,9 @@ print WARN tab(5, '#define WARNsize'),	"$warn_size\n" ;
 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
 print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
 print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
+my $WARN_TAINTstring = mkOct($warn_size, map $_ * 2, @{ $list{'taint'} });
+
+print WARN tab(5, '#define WARN_TAINTstring'), qq["$WARN_TAINTstring"\n] ;
 
 print WARN <<'EOM';
 
@@ -470,7 +486,7 @@ sub bits {
 	    $mask |= $DeadBits{$word} if $fatal ;
 	}
 	else
-          { croak("unknown warnings category '$word'")}
+          { croak("Unknown warnings category '$word'")}
     }
 
     return $mask ;
@@ -493,7 +509,7 @@ sub unimport {
         $mask |= $Bits{'all'} ;
         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
     }
-    ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
+    ${^WARNING_BITS} = $mask & ~ (bits('FATAL' => (@_ ? @_ : 'all')) | $All) ;
 }
 
 sub __chk
@@ -507,12 +523,12 @@ sub __chk
         $category = shift ;
         if (ref $category) {
             croak ("not an object")
-                if $category !~ /^([^=]+)=/ ;+
+                if $category !~ /^([^=]+)=/ ;
 	    $category = $1 ;
             $isobj = 1 ;
         }
         $offset = $Offsets{$category};
-        croak("unknown warnings category '$category'")
+        croak("Unknown warnings category '$category'")
 	    unless defined $offset;
     }
     else {