add CvEVAL_COMPILED() flag and fix closure bug.

EVAL CVs are treated a bit weirdly: their CvROOT() and CvSTART() fields
don't get populated; instead the current values are stored in the
PL_eval_root and PL_eval_start variables while they are being executed.

This caused a bug in closures and nested evals when an inner eval was
repeated twice. The first inner eval accessed an outer lexical, which
caused a fake cache entry to be added to the outer eval's pad. The
second inner eval finds this cached entry, but incorrectly concludes
that the outer eval is in fact an anon sub prototype and issues a
'variable is not available' warning. This is due to this simplistic
definition in pad.c:

    #define CvCOMPILED(cv) CvROOT(cv)

This commit adds a new flag, CvEVAL_COMPILED(), to indicate a
fully-compiled EVAL CV. This allows us to work around the limitation.

In an ideal world this would have been fixed instead by making EVAL CVs
first-class citizens with CvROOT() etc, but plenty of stuff seems to
assume otherwise. So I took the path of least resistance.

See https://www.perlmonks.org/?node_id=11158351
This commit is contained in:
David Mitchell 2024-03-21 15:04:51 +00:00
parent 5f29d4af0d
commit d06d7106c2
5 changed files with 29 additions and 4 deletions

5
cv.h
View File

@ -140,6 +140,7 @@ See L<perlguts/Autoloading with XSUBs>.
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<CvREFCOUNTED_ANYSV> 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

3
dump.c
View File

@ -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[] = {

1
op.c
View File

@ -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;
}

5
pad.c
View File

@ -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)

View File

@ -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");
}