From 558b442404962caba5a81ad5b785fef3cf5eac5d Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 7 Dec 2010 18:02:16 -0800 Subject: [PATCH] [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. --- pp_ctl.c | 19 +++++++++++++++++++ t/re/reg_eval_scope.t | 3 ++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/pp_ctl.c b/pp_ctl.c index 48a4e41..0e62d50 100644 --- 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 --- 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 -- 1.8.3.1