Change 11156 by jhi@alpha on 2001/07/05 03:43:28
Subject: [PATCH perl@11099]Re: [ID 20010704.003] Taint mode breaks global match
From: Radu Greab <[EMAIL PROTECTED]>
Date: Wed, 4 Jul 2001 22:13:31 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/op.c#404 edit
... //depot/perl/sv.c#434 edit
... //depot/perl/t/op/pos.t#3 edit
Differences ...
==== //depot/perl/op.c#404 (text) ====
Index: perl/op.c
--- perl/op.c.~1~ Wed Jul 4 21:45:06 2001
+++ perl/op.c Wed Jul 4 21:45:06 2001
@@ -2035,9 +2035,15 @@
right->op_type == OP_SUBST ||
right->op_type == OP_TRANS)) {
right->op_flags |= OPf_STACKED;
- if (right->op_type != OP_MATCH &&
- ! (right->op_type == OP_TRANS &&
- right->op_private & OPpTRANS_IDENTICAL))
+ if ((right->op_type != OP_MATCH &&
+ ! (right->op_type == OP_TRANS &&
+ right->op_private & OPpTRANS_IDENTICAL)) ||
+ /* if SV has magic, then match on original SV, not on its copy.
+ see note in pp_helem() */
+ (right->op_type == OP_MATCH &&
+ (left->op_type == OP_AELEM ||
+ left->op_type == OP_HELEM ||
+ left->op_type == OP_AELEMFAST)))
left = mod(left, right->op_type);
if (right->op_type == OP_TRANS)
o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
==== //depot/perl/sv.c#434 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Wed Jul 4 21:45:06 2001
+++ perl/sv.c Wed Jul 4 21:45:06 2001
@@ -4415,9 +4415,9 @@
mg->mg_moremagic = SvMAGIC(sv);
SvMAGIC(sv) = mg;
- /* Some magic sontains a reference loop, where the sv and object refer to
- each other. To prevent a avoid a reference loop that would prevent such
- objects being freed, we look for such loops and if we find one we avoid
+ /* Some magic contains a reference loop, where the sv and object refer to
+ each other. To avoid a reference loop that would prevent such objects
+ being freed, we look for such loops and if we find one we avoid
incrementing the object refcount. */
if (!obj || obj == sv ||
how == PERL_MAGIC_arylen ||
==== //depot/perl/t/op/pos.t#3 (xtext) ====
Index: perl/t/op/pos.t
--- perl/t/op/pos.t.~1~ Wed Jul 4 21:45:06 2001
+++ perl/t/op/pos.t Wed Jul 4 21:45:06 2001
@@ -1,6 +1,6 @@
#!./perl
-print "1..4\n";
+print "1..7\n";
$x='banana';
$x=~/.a/g;
@@ -19,5 +19,21 @@
print "not " unless $x eq "0123 5678910?";
print "ok 4\n";
+# bug ID 20010704.003
+use Tie::Scalar;
+tie $y[0], Tie::StdScalar or die $!;
+$y[0] = "aaa";
+$y[0] =~ /./g;
+if (pos($y[0]) == 1) {print "ok 5\n"} else {print "not ok 5\n"}
+$x = 0;
+$y[0] = "aaa";
+$y[$x] =~ /./g;
+if (pos($y[$x]) == 1) {print "ok 6\n"} else {print "not ok 6\n"}
+untie $y[0];
+tie $y{'abc'}, Tie::StdScalar or die $!;
+$y{'abc'} = "aaa";
+$y{'abc'} =~ /./g;
+if (pos($y{'abc'}) == 1) {print "ok 7\n"} else {print "not ok 7\n"}
+untie $y{'abc'};
End of Patch.
