diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-07-25 18:08:23 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2013-08-25 12:25:23 -0700 |
commit | 232af1f839acc29d9ac336d13ff67802d236c38b (patch) | |
tree | 88b77f03c37a8c3d9be88de6822e11031523aafe | |
parent | 75d43e96c14b942bfcfb92795255377905baf38d (diff) | |
download | perl-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.c | 2 | ||||
-rw-r--r-- | t/re/pat.t | 10 |
2 files changed, 11 insertions, 1 deletions
@@ -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)', |