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.

diff --git a/mg.c b/mg.c
index b7f9c05..ea912b3 100644 (file)
--- 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 4426caa..5c44429 100644 (file)
--- 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)',