[perl #66104] Bugs in extended regexp features

More precisely: Make run-time (?{...}) inherit pragmata.

This commit makes Perl_sv_compile_2op_is_broken (nice name!) copy the
hints from PL_curcop if invoked during run time. Usually they are
inherited from the code that is currently being compiled (which works
for $foo =~ /(?{...})/), but the code currently being compiled is not
the enclosing scope at run time ($bar = '(?{...})'; $foo =~ $bar),
hence the need for copying in a similar manner to pp_entereval.

Theoretically this code should also have to avoid copying a statement
label, but goto inside a regexp eval does not currently work, so I
cannot prove or disprove that yet.

diff --git a/pp_ctl.c b/pp_ctl.c
index 48a4e41..0e62d50 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3092,8 +3092,27 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
     /* we get here either during compilation, or via pp_regcomp at runtime */
     runtime = IN_PERL_RUNTIME;
     if (runtime)
+    {
        runcv = find_runcv(NULL);
 
+       /* At run time, we have to fetch the hints from PL_curcop. */
+       PL_hints = PL_curcop->cop_hints;
+       if (PL_hints & HINT_LOCALIZE_HH) {
+           /* SAVEHINTS created a new HV in PL_hintgv, which we
+              need to GC */
+           SvREFCNT_dec(GvHV(PL_hintgv));
+           GvHV(PL_hintgv) =
+            refcounted_he_chain_2hv(PL_curcop->cop_hints_hash, 0);
+           hv_magic(GvHV(PL_hintgv), NULL, PERL_MAGIC_hints);
+       }
+       SAVECOMPILEWARNINGS();
+       PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
+       cophh_free(CopHINTHASH_get(&PL_compiling));
+       /* XXX Does this need to avoid copying a label? */
+       PL_compiling.cop_hints_hash
+        = cophh_copy(PL_curcop->cop_hints_hash);
+    }
+
     PL_op = &dummy;
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */

diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index 8c8be6a..bd9ef84 100644 (file)
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -104,13 +104,14 @@ off;
   "ba" =~ /${\'(?{ $::pack = __PACKAGE__ })a'}/;
 }
 is $pack, 'bar', '/$text/ containing (?{}) inherits package';
-on;
 {
   use re 'eval', "/m";
   "ba" =~ /${\'(?{ $::re = qr -- })a'}/;
 }
 is $re, '(?^m:)', '/$text/ containing (?{}) inherits pragmata';
 
+on;
+
 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{die})';
  eval { "a" =~ /(?{die})a/ }; print "ok"
 CODE