diff --git a/cv.h b/cv.h index 63112ff249a9..51437e4289f9 100644 --- a/cv.h +++ b/cv.h @@ -140,6 +140,7 @@ See L. CVf_METHOD; now CVf_NOWARN_AMBIGUOUS */ #define CVf_XS_RCSTACK 0x200000 /* the XS function understands a reference-counted stack */ +#define CVf_EVAL_COMPILED 0x400000 /* an eval CV is fully compiled */ /* This symbol for optimised communication between toke.c and op.c: */ #define CVf_BUILTIN_ATTRS (CVf_NOWARN_AMBIGUOUS|CVf_LVALUE|CVf_ANONCONST) @@ -266,6 +267,10 @@ Helper macro to turn off the C flag. #define CvXS_RCSTACK_on(cv) (CvFLAGS(cv) |= CVf_XS_RCSTACK) #define CvXS_RCSTACK_off(cv) (CvFLAGS(cv) &= ~CVf_XS_RCSTACK) +#define CvEVAL_COMPILED(cv) (CvFLAGS(cv) & CVf_EVAL_COMPILED) +#define CvEVAL_COMPILED_on(cv) (CvFLAGS(cv) |= CVf_EVAL_COMPILED) +#define CvEVAL_COMPILED_off(cv) (CvFLAGS(cv) &= ~CVf_EVAL_COMPILED) + /* Back-compat */ #ifndef PERL_CORE # define CVf_METHOD CVf_NOWARN_AMBIGUOUS diff --git a/dump.c b/dump.c index f6c0d32f301d..f3576d41c53d 100644 --- a/dump.c +++ b/dump.c @@ -1782,7 +1782,8 @@ const struct flag_to_name cv_flags_names[] = { {CVf_SIGNATURE, "SIGNATURE,"}, {CVf_REFCOUNTED_ANYSV, "REFCOUNTED_ANYSV,"}, {CVf_IsMETHOD, "IsMETHOD,"}, - {CVf_XS_RCSTACK, "XS_RCSTACK,"} + {CVf_XS_RCSTACK, "XS_RCSTACK,"}, + {CVf_EVAL_COMPILED, "EVAL_COMPILED,"}, }; const struct flag_to_name hv_flags_names[] = { diff --git a/op.c b/op.c index 55a2071d33da..4e3078674983 100644 --- a/op.c +++ b/op.c @@ -4702,6 +4702,7 @@ Perl_newPROG(pTHX_ OP *o) SAVEFREEOP(o); ENTER; S_process_optree(aTHX_ NULL, PL_eval_root, start); + CvEVAL_COMPILED_on(PL_compcv); /* this eval is now fully compiled */ LEAVE; PL_savestack_ix = i; } diff --git a/pad.c b/pad.c index 921c10d1cefa..b61ee3e80b8b 100644 --- a/pad.c +++ b/pad.c @@ -1079,8 +1079,9 @@ index into the parent pad. */ /* the CV has finished being compiled. This is not a sufficient test for - * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */ -#define CvCOMPILED(cv) CvROOT(cv) + * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain. + * Note that a fully-compiled eval doesn't get CvROOT() set. */ +#define CvCOMPILED(cv) (CvROOT(cv) || CvEVAL_COMPILED(cv)) /* the CV does late binding of its lexicals */ #define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM) diff --git a/t/op/eval.t b/t/op/eval.t index 0d7e65011da6..079aef2ed217 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan(tests => 169); +plan(tests => 170); eval 'pass();'; @@ -768,3 +768,20 @@ pass("eval in freed package does not crash"); ); } } + +# The first inner eval finds the $v and adds a fake entry to the +# outer eval's pad. The second inner eval finds the fake $c entry, +# but was incorrectly concluding that the outer eval was in fact a +# non-live anon prototype and issuing the warning +# 'Variable "$v" is not available'/ + +{ + use warnings; + my $w = 0; + local $SIG{__WARN__} = sub { $w++ }; + sub { + my $v; + eval q( eval '$v'; eval '$v';); + }->(); + is($w, 0, "nested eval and closure"); +}