From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 8 Oct 2001 17:00:14 +0000 (-0400)
Subject: Re: [PATCH mg.c gv.c and others] ${^TAINT}
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7c36658b988154cf97fb44e48a4b69859fe075fb;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH mg.c gv.c and others] ${^TAINT}
Message-ID: <20011008170014.L17083@blackrider>

p4raw-id: //depot/perl@12367
---

diff --git a/gv.c b/gv.c
index 2ed4809..e3cb25a 100644
--- a/gv.c
+++ b/gv.c
@@ -893,7 +893,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '\011':	/* $^I, NOT \t in EBCDIC */
     case '\016':        /* $^N */
     case '\020':	/* $^P */
-    case '\024':	/* $^T */
 	if (len > 1)
 	    break;
 	goto magicalize;
@@ -910,6 +909,13 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	if (len > 1)
 	    break;
 	goto ro_magicalize;
+    case '\024':	/* $^T */
+        if (len == 1)
+            goto magicalize;
+        else if (strEQ(name, "\024AINT"))
+            goto ro_magicalize;
+        else
+            break;
     case '\027':	/* $^W & $^WARNING_BITS */
 	if (len > 1 && strNE(name, "\027ARNING_BITS")
 	    && strNE(name, "\027IDE_SYSTEM_CALLS"))
diff --git a/mg.c b/mg.c
index 0fb1a86..4e186e0 100644
--- a/mg.c
+++ b/mg.c
@@ -612,12 +612,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '\024':		/* ^T */
+        if (*(mg->mg_ptr+1) == '\0') {
 #ifdef BIG_TIME
- 	sv_setnv(sv, PL_basetime);
+            sv_setnv(sv, PL_basetime);
 #else
-	sv_setiv(sv, (IV)PL_basetime);
+            sv_setiv(sv, (IV)PL_basetime);
 #endif
-	break;
+        }
+        else if (strEQ(mg->mg_ptr, "\024AINT"))
+            sv_setiv(sv, PL_tainting);
+        break;
     case '\027':		/* ^W  & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */
 	if (*(mg->mg_ptr+1) == '\0')
 	    sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 6f9bd8d..aec8215 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -1039,6 +1039,11 @@ The time at which the program began running, in seconds since the
 epoch (beginning of 1970).  The values returned by the B<-M>, B<-A>,
 and B<-C> filetests are based on this value.
 
+=item ${^TAINT}
+
+Reflects if taint mode is on or off (ie. if the program was run with
+B<-T> or not).  True for on, false for off.
+
 =item $PERL_VERSION
 
 =item $^V
diff --git a/t/op/magic.t b/t/op/magic.t
index bbccd8e..20d973b 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -35,7 +35,7 @@ sub skip {
     return 1;
 }
 
-print "1..41\n";
+print "1..43\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -283,3 +283,7 @@ ok ${"!"}{ENOENT};
 ok $^S == 0;
 eval { ok $^S == 1 };
 ok $^S == 0;
+
+ok ${^TAINT} == 0;
+eval { ${^TAINT} = 1 };
+ok ${^TAINT} == 0;
diff --git a/t/op/taint.t b/t/op/taint.t
index 8ae8202..d010afe 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -15,6 +15,20 @@ BEGIN {
 use strict;
 use Config;
 
+my $test = 177;
+sub ok {
+    my($ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+    $test++;
+    return $ok;
+}
+
+
 $| = 1;
 
 # We do not want the whole taint.t to fail
@@ -109,7 +123,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..176\n";
+print "1..179\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -885,3 +899,10 @@ else {
 }
 
 
+ok( ${^TAINT},  '$^TAINT is on' );
+
+eval { ${^TAINT} = 0 };
+ok( ${^TAINT},  '$^TAINT is not assignable' );
+ok( $@ =~ /^Modification of a read-only value attempted/,
+                                'Assigning to taint pukes properly' );
+