summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--op.c12
-rw-r--r--sv.c6
-rwxr-xr-xt/op/pos.t22
3 files changed, 31 insertions, 9 deletions
diff --git a/op.c b/op.c
index 2e6a13d02e..44c473954d 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 d14810cc33..a7e1bda293 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 f3bc23c84a..7c4c1c567d 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'};