[PATCH] Re: [ID 20011111.105] qr/$ARGV[0]/ not tainted

From: Robert Spier <rspier@pobox.com>
Date: Sun, 11 Nov 2001 18:50:18 -0800
Message-Id: <15343.14570.121505.233336@rls.cx>

Subject: Re: [PATCH] Re: [ID 20011111.105] qr/$ARGV[0]/ not tainted
From: Rick Delaney <rick.delaney@home.com>
Date: 12 Nov 2001 00:15:52 -0500
Message-Id: <m3wv0wmuwn.fsf@cs839290-a.mtth1.on.wave.home.com>

p4raw-id: //depot/perl@12949

diff --git a/pp_hot.c b/pp_hot.c
index ab1e9fb..f1274a6 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1189,6 +1189,8 @@ PP(pp_qr)
     register PMOP *pm = cPMOP;
     SV *rv = sv_newmortal();
     SV *sv = newSVrv(rv, "Regexp");
+    if (pm->op_pmdynflags & PMdf_TAINTED)
+        SvTAINTED_on(rv);
     sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
     RETURNX(PUSHs(rv));
 }

diff --git a/t/op/taint.t b/t/op/taint.t
index 6254eb9..29b5839 100755 (executable)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -123,7 +123,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..179\n";
+print "1..182\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -906,3 +906,15 @@ ok( ${^TAINT},  '$^TAINT is not assignable' );
 ok( $@ =~ /^Modification of a read-only value attempted/,
                                 'Assigning to ${^TAINT} fails' );
 
+{
+    # bug 20011111.105
+    
+    my $re1 = qr/x$TAINT/;
+    test 180, tainted $re1;
+    
+    my $re2 = qr/^$re1\z/;
+    test 181, tainted $re2;
+    
+    my $re3 = "$re2";
+    test 182, tainted $re3;
+}