re_eval: clear lexicals in the right pad

(?{...}) deliberately doesn't introduce a new scope (so that the affects of
local() can accumulate across multiple calls to the code). This also means
that the SAVEt_CLEARSVs pushed onto the save stack by lexical declarations
(i.e. (?{ my $x; ... }) also accumulate, and are only processed en-mass at
the end, on exit from the regex. Currently they are usually processed in
the wrong pad (the caller of the pattern, rather than the pads of the
individual code block(s)), leading to random misbehaviour and SEGVs.

Hence the long-standing advice to avoid lexical declarations within
re_evals.

We fix this by wrapping a pair of SAVECOMPPADs around each call to a code
block. Eventually the save stack will be a long accumulation of
SAVEt_CLEARSV's interspersed with SAVEt_COMPPAD's, that when popped
en-mass should unwind in the right order with the right pad at the right
time.

The price to pay for this is two extra additions to the save stack (which
accumulate) for each code call.

A few TODO tests in reg_eval_scope.t now pass, so I'm probably doing the
right thing ;-)

2 files changed, 13 insertions, 1 deletions

diff --git a/regexec.c b/regexec.c
index cbaf1df5c2..62c7f87bae 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4214,6 +4214,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		PL_op = (OP_4tree*)rexi->data->data[n];
 		DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, 
 		    "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
+		/* wrap the call in two SAVECOMPPADs. This ensures that
+		 * when the save stack is eventually unwound, all the
+		 * accumulated SAVEt_CLEARSV's will be processed with
+		 * interspersed SAVEt_COMPPAD's to ensure that lexicals
+		 * are cleared in the right pad */
+		SAVECOMPPAD();
 		PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
 		PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
 
@@ -4234,6 +4240,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		Copy(&saved_state, &PL_reg_state, 1, struct re_save_state);
 
 		PL_op = oop;
+		SAVECOMPPAD();
 		PAD_RESTORE_LOCAL(old_comppad);
 		PL_curcop = ocurcop;
 		PL_regeol = saved_regeol;
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index 860b4c80f7..a23321f2d2 100644
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -16,7 +16,6 @@ plan 17;
 sub on { $::TODO = "(?{}) implementation is screwy" }
 sub off { undef $::TODO }
 
-on;
 
 fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  my $x = 7; my $a = 4; my $b = 5;
@@ -24,6 +23,8 @@ fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  print $x,$a,$b;
 CODE
 
+on;
+
 fresh_perl_is <<'CODE',
  for my $x("a".."c") {
   $y = 1;
@@ -43,6 +44,8 @@ CODE
   {},
  'multiple (?{})s in loop with lexicals';
 
+off;
+
 fresh_perl_is <<'CODE', '781745', {}, 'run-time re-eval has its own scope';
  use re qw(eval);
  my $x = 7;  my $a = 4; my $b = 5;
@@ -85,6 +88,8 @@ fresh_perl_is <<'CODE', '178279371047857967101745', {},
 CODE
  'multiple (?{})s in "foo" =~ /$string/x';
 
+on;
+
 fresh_perl_is <<'CODE', '123123', {},
   for my $x(1..3) {
    push @regexps = qr/(?{ print $x })a/;