summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-07-25 18:08:23 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-08-25 12:25:23 -0700
commit232af1f839acc29d9ac336d13ff67802d236c38b (patch)
tree88b77f03c37a8c3d9be88de6822e11031523aafe
parent75d43e96c14b942bfcfb92795255377905baf38d (diff)
downloadperl-232af1f839acc29d9ac336d13ff67802d236c38b.tar.gz
Stop values from ‘sticking’ to @- and @+ elems
These arrays are very similar to tied arrays, in that the elements are created on the fly when looked up. So push @_, \$+[0], \$+[0], will push references to two different scalars on to @_. That they are created on the fly prevents this bug from showing up in most code: If you reference the element you can observe that, on FETCH, it gets set to the corresponding offset *if* the last match has a set of capturing parentheses with the right number. Otherwise, the value in the element is left as-is. So, doing another pattern match with, say, 5 captures and then another with fewer will leave $+[5] and $-[5] holding values from the first match, if there is a FETCH in between the two matches: $ perl -le '" "=~/()()()()(..)/; $_ = \$+[5]; print $$_; ""=~ /()/; print $$_;' 2 2 And attempts at assignment will succeed, even though they croak: $ perl -le 'for ($-[0]) { eval { $_ = *foo }; print $_ }' *main::foo The solution here is to make the magic ‘get’ handler set the SV no matter what, instead of just setting it when it refers to a valid offset.
-rw-r--r--mg.c2
-rw-r--r--t/re/pat.t10
2 files changed, 11 insertions, 1 deletions
diff --git a/mg.c b/mg.c
index b7f9c05d8b..ea912b3412 100644
--- a/mg.c
+++ b/mg.c
@@ -684,9 +684,11 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
}
sv_setuv(sv, i);
+ return 0;
}
}
}
+ sv_setsv(sv, NULL);
return 0;
}
diff --git a/t/re/pat.t b/t/re/pat.t
index 4426caabb3..5c444299c3 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 696; # Update this when adding/deleting tests.
+plan tests => 698; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -703,6 +703,14 @@ sub run_tests {
/.(a)(ba*)?/;
is($#+, 2, $message);
is($#-, 1, $message);
+
+ # Check that values don’t stick
+ " "=~/()()()(.)(..)/;
+ my($m,$p) = (\$-[5], \$+[5]);
+ () = "$$_" for $m, $p; # FETCH (or eqv.)
+ " " =~ /()/;
+ is $$m, undef, 'values do not stick to @- elements';
+ is $$p, undef, 'values do not stick to @+ elements';
}
foreach ('$+[0] = 13', '$-[0] = 13', '@+ = (7, 6, 5)',