-t without -w

Message-ID: <20011230044625.GA14386@blackrider>

p4raw-id: //depot/perl@13953

diff --git a/perl.c b/perl.c
index 50e7aa1..a96fbbd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1100,11 +1100,15 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            break;
 
        case 't':
-           PL_taint_warn = TRUE;
-           if (! (PL_dowarn & G_WARN_ALL_MASK))
-               PL_dowarn |= G_WARN_ON;
+           if( !PL_tainting ) {
+                PL_taint_warn = TRUE;
+                PL_tainting = TRUE;
+           }
+           s++;
+           goto reswitch;
        case 'T':
            PL_tainting = TRUE;
+           PL_taint_warn = FALSE;
            s++;
            goto reswitch;
 
@@ -1283,8 +1287,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
        char *popt = s;
        while (isSPACE(*s))
            s++;
-       if (*s == '-' && *(s+1) == 'T')
+       if (*s == '-' && *(s+1) == 'T') {
            PL_tainting = TRUE;
+            PL_taint_warn = FALSE;
+       }
        else {
            char *popt_copy = Nullch;
            while (s && *s) {
@@ -1313,8 +1319,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
                    }
                }
                if (*d == 't') {
-                   PL_tainting = TRUE;
-                   PL_taint_warn = TRUE;
+                   if( !PL_tainting ) {
+                       PL_taint_warn = TRUE;
+                       PL_tainting = TRUE;
+                   }
                } else {
                    moreswitches(d);
                }
@@ -1322,6 +1330,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
        }
     }
 
+    if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
+       PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+    }
+
     if (!scriptname)
        scriptname = argv[0];
     if (PL_e_script) {
@@ -2509,11 +2521,15 @@ 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;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_ALL ;
        s++;
        return s;
     case 'X':
        PL_dowarn = G_WARN_ALL_OFF;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_NONE ;
        s++;
        return s;

diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 137ecd3..138e344 100644 (file)
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -700,8 +700,8 @@ program will be searched for strictly on the PATH.
 =item B<-t>
 
 Like B<-T>, but taint checks will issue warnings rather than fatal
-errors.  Also, all warnings are turned on as if you had used also
-a B<-w>.
+errors.  These warnings can be controlled normally with C<no warnings
+qw(taint)>.
 
 B<NOTE: this is not a substitute for -T.> This is meant only to be
 used as a temporary development aid while securing legacy code:

diff --git a/pp_ctl.c b/pp_ctl.c
index 46a900a..7d777f5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3166,6 +3166,8 @@ trylocal: {
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
         PL_compiling.cop_warnings = pWARN_NONE ;
+    else if (PL_taint_warn)
+        PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
     else
         PL_compiling.cop_warnings = pWARN_STD ;
     SAVESPTR(PL_compiling.cop_io);

diff --git a/t/run/switcht.t b/t/run/switcht.t
index bb52252..2ac9ed0 100644 (file)
--- a/t/run/switcht.t
+++ b/t/run/switcht.t
@@ -1,4 +1,4 @@
-#!./perl -tw
+#!./perl -t
 
 BEGIN {
     chdir 't';
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 10;
+plan tests => 11;
 
 my $Perl = which_perl();
 
@@ -41,3 +41,5 @@ unlink($file);
 like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
                                                   'unlink() taint warn' );
 ok( !-e $file,  'unlink worked' );
+
+ok( !$^W,   "-t doesn't enable regular warnings" );

diff --git a/warnings.h b/warnings.h
index de9355d..d173b8d 100644 (file)
--- a/warnings.h
+++ b/warnings.h
@@ -71,6 +71,7 @@
 #define WARNsize               12
 #define WARN_ALLstring         "\125\125\125\125\125\125\125\125\125\125\125\125"
 #define WARN_NONEstring                "\0\0\0\0\0\0\0\0\0\0\0\0"
+#define WARN_TAINTstring       "\0\0\0\0\0\0\0\0\0\20\0\0"
 
 #define isLEXWARN_on   (PL_curcop->cop_warnings != pWARN_STD)
 #define isLEXWARN_off  (PL_curcop->cop_warnings == pWARN_STD)

diff --git a/warnings.pl b/warnings.pl
index 5903348..e317b0a 100644 (file)
--- a/warnings.pl
+++ b/warnings.pl
@@ -143,9 +143,9 @@ sub printTree
 
 ###########################################################################
 
-sub mkHex
+sub mkHexOct
 {
-    my ($max, @a) = @_ ;
+    my ($f, $max, @a) = @_ ;
     my $mask = "\x00" x $max ;
     my $string = "" ;
 
@@ -153,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")
@@ -222,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';