Skip to content

Commit

Permalink
Revert "[perl #89544] Non-eval closures don’t need CvOUTSIDE"
Browse files Browse the repository at this point in the history
But they do need CvOUTSIDE() for eval-in-package-DB's scope
magic to work correctly.

This also incidentally fixes a TODO Deparse, since the CvOUTSIDE
is now available

Fixes Perl#19370 aka rt89544

This breaks Perl#11286, but I don't think that's fixable without breaking
eval-in-DB's special scope behaviour.

This reverts (most of) commit a0d2bbd.
  • Loading branch information
tonycoz committed Sep 14, 2023
1 parent dada38b commit f453ca4
Show file tree
Hide file tree
Showing 7 changed files with 8 additions and 16 deletions.
6 changes: 1 addition & 5 deletions cv.h
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,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 */
#define CVf_HASEVAL 0x4000 /* contains string eval */
/* 0x4000 previously CVf_HASEVAL */
#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 @@ -213,10 +213,6 @@ 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: 0 additions & 1 deletion dump.c
Original file line number Diff line number Diff line change
Expand Up @@ -1774,7 +1774,6 @@ 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(?:[c4]00)?0 # $] < 5.015 || !thr
FLAGS = 0x[cd145]000 # $] >= 5.015 && thr
FLAGS = 0x(?:[c84]00)?0 # $] < 5.015 || !thr
FLAGS = 0x[cd1459]000 # $] >= 5.015 && thr
OUTSIDE_SEQ = \\d+
PADLIST = $ADDR
PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
Expand Down
1 change: 0 additions & 1 deletion lib/B/Deparse.t
Original file line number Diff line number Diff line change
Expand Up @@ -2171,7 +2171,6 @@ 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: 1 addition & 3 deletions pad.c
Original file line number Diff line number Diff line change
Expand Up @@ -1694,7 +1694,6 @@ 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 @@ -1986,8 +1985,7 @@ 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 */

if (CvHASEVAL(cv))
CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));

SAVESPTR(PL_comppad_name);
PL_comppad_name = protopad_name;
Expand Down
3 changes: 2 additions & 1 deletion 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]
# [perl #89544] aka [GH #11286]
{
sub trace::DESTROY {
push @trace::trace, "destroyed";
Expand All @@ -711,6 +711,7 @@ $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: 0 additions & 1 deletion t/op/eval.t
Original file line number Diff line number Diff line change
Expand Up @@ -379,7 +379,6 @@ 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 f453ca4

Please sign in to comment.