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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (executable)
--- 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' );
+