From df42552b9791520cce8e53b2ba894b77d8110e6d Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 1 Oct 2024 09:22:09 +1000 Subject: [PATCH 1/3] =?UTF-8?q?Revert=20"Revert=20"[perl=20#89544]=20Non-e?= =?UTF-8?q?val=20closures=20don=E2=80=99t=20need=20CvOUTSIDE""?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit 386907f061c1812ecaa5f3c88d9f729828408097. Reinstates the behaviour of CV outside references from 5.38, fixing #22547 Breaks #19370 --- cv.h | 6 +++++- dump.c | 1 + ext/Devel-Peek/t/Peek.t | 8 ++++---- lib/B/Deparse.t | 1 + pad.c | 4 +++- t/op/closure.t | 3 +-- t/op/eval.t | 1 + 7 files changed, 16 insertions(+), 8 deletions(-) diff --git a/cv.h b/cv.h index 5a5c90ffab4b..6b8f6486c7dd 100644 --- a/cv.h +++ b/cv.h @@ -147,7 +147,7 @@ See L. #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 */ @@ -232,6 +232,10 @@ See L. #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) diff --git a/dump.c b/dump.c index cdbbb0e2819d..5eea86c37630 100644 --- a/dump.c +++ b/dump.c @@ -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,"}, diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index d6f1f21e68a5..80dd0b151f7b 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -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 @@ -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\\) diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 59f937dcc52d..ec90115fe7b5 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -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'; (); diff --git a/pad.c b/pad.c index 9b943b1158e4..765c702456d7 100644 --- a/pad.c +++ b/pad.c @@ -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); } } @@ -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; diff --git a/t/op/closure.t b/t/op/closure.t index be7da997b7c0..c92e6456d98b 100644 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -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"; @@ -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'; } diff --git a/t/op/eval.t b/t/op/eval.t index 079aef2ed217..78fc64609823 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -379,6 +379,7 @@ our $x = 1; is(db6(), 4); # [GH #19370] + local $TODO = "outside not available when needed"; my sub d6 { DB::db3(); } From 7827461d9d638a48402d9cb71d905c8cc95e4f24 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 1 Oct 2024 10:06:17 +1000 Subject: [PATCH 2/3] closure outside linking: test the reported test case and a version with eval EXPR which will remain broken --- t/op/closure.t | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/t/op/closure.t b/t/op/closure.t index c92e6456d98b..cce22f7df079 100644 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -811,4 +811,47 @@ sub { }; test_ref_to_unavailable(); +{ + # 22547 + fresh_perl_is(<<'EOC', "OK", {}, "RT #22547"); +use builtin qw(weaken); + +my $wref; +{ + my $x; + my $subject = sub { + $x = $_[0]; + + my $y; + return sub { $y }; + }; + my $subscriber = {}; + weaken($wref = $subscriber); + $subscriber->{foo} = $subject->($subscriber); +} +!defined $wref and print "OK"; +EOC + + local $TODO = "still leaks with eval ''"; + fresh_perl_is(<<'EOC', "OK", {}, "RT #22547 with eval"); +use builtin qw(weaken); + +my $wref; +{ + my $x; + my $subject = sub { + $x = $_[0]; + + my $y; + return sub { eval "1"; $y }; + }; + my $subscriber = {}; + weaken($wref = $subscriber); + $subscriber->{foo} = $subject->($subscriber); +} +!defined $wref and print "OK"; +EOC +} + + done_testing(); From 891dd58847b0e71b9c740215834d05c147bbd336 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 18 Nov 2024 13:19:37 +1100 Subject: [PATCH 3/3] DB::eval CvOUTSIDE: some more tests --- t/op/eval.t | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/t/op/eval.t b/t/op/eval.t index 78fc64609823..8a1138bef5ec 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan(tests => 170); +plan(tests => 172); eval 'pass();'; @@ -392,6 +392,57 @@ our $x = 1; is($d7->(), 3); } +{ + # github 22547 + # these produce the expected results with 5.40.0 + local $TODO = "eval from DB outside chain is broken"; + fresh_perl_is(<<'CODE', "1.1\n1.2\n2\n", {}, "lexical lookup from DB::"); +use builtin qw(ceil); +use strict; + +package DB { + sub do_eval { eval shift or $@; } +} + +{ + my $xx = 1.2; + my sub f { + print DB::do_eval(shift), "\n"; + } + f('1.1'); + f('$xx'); + f('ceil(1.1)'); +} +CODE + + # subtley different, one of the suggested solutions was to make + # CvOUTSIDE a weak reference, but in the case below $f exits before + # the eval is called, so the outside link from the closure it returns + # would break for a weak reference. + fresh_perl_is(<<'CODE', "1.1\n1.2\n2\n", {}, "lexical lookup from DB::"); +use strict; + +package DB { + sub do_eval { eval shift or $@; } +} + +sub g { + my $yy; + my $f = sub { + $yy; # closure + use builtin qw(ceil); + our $xx = 1.2; + my $yy = shift; + return sub { print DB::do_eval($yy) || $@, "\n" }; + }; + return $f->(shift); +} +g('1.1')->(); +g('$xx')->(); +g('ceil(1.1)')->(); +CODE +} + # [perl #19022] used to end up with shared hash warnings # The program should generate no output, so anything we see is on stderr my $got = runperl (prog => '$h{a}=1; foreach my $k (keys %h) {eval qq{\$k}}',