-t without -w

Message-ID: <20011230044625.GA14386@blackrider>

p4raw-id: //depot/perl@13953

6 files changed, 54 insertions, 15 deletions

diff --git a/perl.c b/perl.c
index 50e7aa1bcb..a96fbbd093 100644
--- 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 137ecd30d8..138e34499c 100644
--- 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 46a900a9c3..7d777f583f 100644
--- 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 bb52252291..2ac9ed0d46 100644
--- 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 de9355ddfa..d173b8d208 100644
--- 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 59033486f2..e317b0a48e 100644
--- 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';