summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl.c28
-rw-r--r--pod/perlrun.pod4
-rw-r--r--pp_ctl.c2
-rw-r--r--t/run/switcht.t6
-rw-r--r--warnings.h1
-rw-r--r--warnings.pl28
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';
View Lorry Controller Status