Skip to content

Commit

Permalink
Revert "Revert "[perl #89544] Non-eval closures don’t need CvOUTSIDE""
Browse files Browse the repository at this point in the history
This reverts commit 386907f.

Reinstates the behaviour of CV outside references from 5.38, fixing Perl#22547

Breaks Perl#19370
  • Loading branch information
tonycoz committed Sep 30, 2024
1 parent 045b0df commit f4530bf
Show file tree
Hide file tree
Showing 7 changed files with 16 additions and 8 deletions.
6 changes: 5 additions & 1 deletion cv.h
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ See L<perlguts/Autoloading with XSUBs>.
#endif
#define CVf_DYNFILE 0x1000 /* The filename is malloced */
#define CVf_AUTOLOAD 0x2000 /* SvPVX contains AUTOLOADed sub name */
/* 0x4000 previously CVf_HASEVAL */
#define CVf_HASEVAL 0x4000 /* contains string eval */
#define CVf_NAMED 0x8000 /* Has a name HEK */
#define CVf_LEXICAL 0x10000 /* Omit package from name */
#define CVf_ANONCONST 0x20000 /* :const - create anonconst op */
Expand Down Expand Up @@ -232,6 +232,10 @@ See L<perlguts/Autoloading with XSUBs>.
#define CvAUTOLOAD_on(cv) (CvFLAGS(cv) |= CVf_AUTOLOAD)
#define CvAUTOLOAD_off(cv) (CvFLAGS(cv) &= ~CVf_AUTOLOAD)

#define CvHASEVAL(cv) (CvFLAGS(cv) & CVf_HASEVAL)
#define CvHASEVAL_on(cv) (CvFLAGS(cv) |= CVf_HASEVAL)
#define CvHASEVAL_off(cv) (CvFLAGS(cv) &= ~CVf_HASEVAL)

#define CvNAMED(cv) (CvFLAGS(cv) & CVf_NAMED)
#define CvNAMED_on(cv) (CvFLAGS(cv) |= CVf_NAMED)
#define CvNAMED_off(cv) (CvFLAGS(cv) &= ~CVf_NAMED)
Expand Down
1 change: 1 addition & 0 deletions dump.c
Original file line number Diff line number Diff line change
Expand Up @@ -1899,6 +1899,7 @@ const struct flag_to_name cv_flags_names[] = {
{CVf_CVGV_RC, "CVGV_RC,"},
{CVf_DYNFILE, "DYNFILE,"},
{CVf_AUTOLOAD, "AUTOLOAD,"},
{CVf_HASEVAL, "HASEVAL,"},
{CVf_SLABBED, "SLABBED,"},
{CVf_NAMED, "NAMED,"},
{CVf_LEXICAL, "LEXICAL,"},
Expand Down
8 changes: 4 additions & 4 deletions ext/Devel-Peek/t/Peek.t
Original file line number Diff line number Diff line change
Expand Up @@ -364,8 +364,8 @@ do_test('reference to named subroutine without prototype',
RV = $ADDR
SV = PVCV\\($ADDR\\) at $ADDR
REFCNT = (3|4)
FLAGS = \\((?:HASEVAL,)?(?:NAMED)?\\) # $] < 5.015 || !thr
FLAGS = \\(DYNFILE(?:,HASEVAL)?(?:,NAMED)?\\) # $] >= 5.015 && thr
FLAGS = \\((?:HASEVAL(?:,NAMED)?)?\\) # $] < 5.015 || !thr
FLAGS = \\(DYNFILE(?:,HASEVAL(?:,NAMED)?)?\\) # $] >= 5.015 && thr
COMP_STASH = $ADDR\\t"main"
START = $ADDR ===> \\d+
ROOT = $ADDR
Expand All @@ -375,8 +375,8 @@ do_test('reference to named subroutine without prototype',
DEPTH = 1(?:
MUTEXP = $ADDR
OWNER = $ADDR)?
FLAGS = 0x(?:[c84]00)?0 # $] < 5.015 || !thr
FLAGS = 0x[cd1459]000 # $] >= 5.015 && thr
FLAGS = 0x(?:[c4]00)?0 # $] < 5.015 || !thr
FLAGS = 0x[cd145]000 # $] >= 5.015 && thr
OUTSIDE_SEQ = \\d+
PADLIST = $ADDR
PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
Expand Down
1 change: 1 addition & 0 deletions lib/B/Deparse.t
Original file line number Diff line number Diff line change
Expand Up @@ -2150,6 +2150,7 @@ my sub g {
sub f { }
}
####
# TODO only partially fixed
# lexical state subroutine with outer declaration and inner definition
# CONTEXT use feature 'lexical_subs', 'state'; no warnings 'experimental::lexical_subs';
();
Expand Down
4 changes: 3 additions & 1 deletion pad.c
Original file line number Diff line number Diff line change
Expand Up @@ -1684,6 +1684,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
"Pad clone on cv=0x%" UVxf "\n", PTR2UV(cv)));
CvCLONE_on(cv);
}
CvHASEVAL_on(cv);
}
}

Expand Down Expand Up @@ -1975,7 +1976,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned,
PL_compcv = cv;
if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */

CvOUTSIDE(cv) = CvREFCNT_inc_simple(outside);
if (CvHASEVAL(cv))
CvOUTSIDE(cv) = CvREFCNT_inc_simple(outside);

SAVESPTR(PL_comppad_name);
PL_comppad_name = protopad_name;
Expand Down
3 changes: 1 addition & 2 deletions t/op/closure.t
Original file line number Diff line number Diff line change
Expand Up @@ -687,7 +687,7 @@ $r = \$x
isnt($s[0], $s[1], "cloneable with //ee");
}

# [perl #89544] aka [GH #11286]
# [perl #89544]
{
sub trace::DESTROY {
push @trace::trace, "destroyed";
Expand All @@ -711,7 +711,6 @@ $r = \$x
};

my $inner = $outer2->();
local $TODO = "we need outside links for debugger behaviour";
is "@trace::trace", "destroyed",
'closures only close over named variables, not entire subs';
}
Expand Down
1 change: 1 addition & 0 deletions t/op/eval.t
Original file line number Diff line number Diff line change
Expand Up @@ -379,6 +379,7 @@ our $x = 1;
is(db6(), 4);

# [GH #19370]
local $TODO = "outside not available when needed";
my sub d6 {
DB::db3();
}
Expand Down

0 comments on commit f4530bf

Please sign in to comment.