From 55d27857a33136b7f5f1ca74b1417d44e4f51b1c Mon Sep 17 00:00:00 2001 From: Radu Greab Date: Thu, 5 Jul 2001 01:13:31 +0300 Subject: [PATCH] (retracted by #13533) Subject: [PATCH perl@11099]Re: [ID 20010704.003] Taint mode breaks global match Message-ID: <15171.27355.895094.128142@ix.netsoft.ro> p4raw-id: //depot/perl@11156 --- op.c | 12 +++++++++--- sv.c | 6 +++--- t/op/pos.t | 22 +++++++++++++++++++--- 3 files changed, 31 insertions(+), 9 deletions(-) diff --git a/op.c b/op.c index 2e6a13d..44c4739 100644 --- a/op.c +++ b/op.c @@ -2035,9 +2035,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) 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); diff --git a/sv.c b/sv.c index d14810c..a7e1bda 100644 --- a/sv.c +++ b/sv.c @@ -4415,9 +4415,9 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam 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 || diff --git a/t/op/pos.t b/t/op/pos.t index f3bc23c..7c4c1c5 100755 --- a/t/op/pos.t +++ b/t/op/pos.t @@ -1,6 +1,6 @@ #!./perl -print "1..4\n"; +print "1..7\n"; $x='banana'; $x=~/.a/g; @@ -19,5 +19,21 @@ $x = "test string?"; $x =~ s/\w/pos($x)/eg; 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'}; -- 2.7.4