In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/30fc7a2809e5a175e2d9bb94d765b2039f270d91?hp=e55ec392015ba0c575cf495206c3121d1989561b>
- Log ----------------------------------------------------------------- commit 30fc7a2809e5a175e2d9bb94d765b2039f270d91 Author: James E Keenan <[email protected]> Date: Sat May 25 21:40:00 2019 -0400 Eliminate modifiable variables in constants Transform previously deprecated cases into exceptions. Update diagnostic; change D to F remove now irrelevant code (TonyC) For: RT 134138 ----------------------------------------------------------------------- Summary of changes: pad.c | 22 ++++------------------ pod/perldiag.pod | 7 +++---- t/op/const-optree.t | 44 ++++++++++++++++++-------------------------- 3 files changed, 25 insertions(+), 48 deletions(-) diff --git a/pad.c b/pad.c index c0098bedf3..7854678928 100644 --- a/pad.c +++ b/pad.c @@ -2127,7 +2127,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, * from the parent */ if (const_sv && SvREFCNT(const_sv) == 2) { const bool was_method = cBOOL(CvMETHOD(cv)); - bool copied = FALSE; if (outside) { PADNAME * const pn = PadlistNAMESARRAY(CvPADLIST(outside)) @@ -2156,28 +2155,15 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, ) == o && !OpSIBLING(o)) { - Perl_ck_warner_d(aTHX_ - packWARN(WARN_DEPRECATED), - "Constants from lexical " - "variables potentially " - "modified elsewhere are " - "deprecated. This will not " - "be allowed in Perl 5.32"); - /* We *copy* the lexical variable, and donate the - copy to newCONSTSUB. Yes, this is ugly, and - should be killed. We need to do this for the - time being, however, because turning on SvPADTMP - on a lexical will have observable effects - elsewhere. */ - const_sv = newSVsv(const_sv); - copied = TRUE; + Perl_croak(aTHX_ + "Constants from lexical variables potentially modified " + "elsewhere are no longer permitted"); } else goto constoff; } } - if (!copied) - SvREFCNT_inc_simple_void_NN(const_sv); + SvREFCNT_inc_simple_void_NN(const_sv); /* If the lexical is not used elsewhere, it is safe to turn on SvPADTMP, since it is only when it is used in lvalue con- text that the difference is observable. */ diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 2aaa5030ec..0144f99e49 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1833,10 +1833,9 @@ The message indicates the type of reference that was expected. This usually indicates a syntax error in dereferencing the constant value. See L<perlsub/"Constant Functions"> and L<constant>. -=item Constants from lexical variables potentially modified elsewhere are -deprecated. This will not be allowed in Perl 5.32 +=item Constants from lexical variables potentially modified elsewhere are no longer permitted -(D deprecated) You wrote something like +(F) You wrote something like my $var; $sub = sub () { $var }; @@ -1853,7 +1852,7 @@ breaks the behavior of closures, in which the subroutine captures the variable itself, rather than its value, so future changes to the variable are reflected in the subroutine's return value. -This usage is deprecated, and will no longer be allowed in Perl 5.32, +This usage was deprecated, and as of Perl 5.32 is no longer allowed, making it possible to change the behavior in the future. If you intended for the subroutine to be eligible for inlining, then diff --git a/t/op/const-optree.t b/t/op/const-optree.t index 4d897d247e..3a8181beb8 100644 --- a/t/op/const-optree.t +++ b/t/op/const-optree.t @@ -8,7 +8,7 @@ BEGIN { require './test.pl'; set_up_inc('../lib'); } -plan 168; +plan 148; # @tests is an array of hash refs, each of which can have various keys: # @@ -25,6 +25,11 @@ plan 168; # deprecated - whether the sub returning a code ref will emit a depreca- # tion warning when called # method - whether the sub has the :method attribute +# exception - sub now throws an exception (previously threw +# deprecation warning) + +my $exception_134138 = 'Constants from lexical variables potentially modified ' + . 'elsewhere are no longer permitted'; # [perl #63540] Don’t treat sub { if(){.....}; "constant" } as a constant sub blonk { ++$blonk_was_called } @@ -47,11 +52,7 @@ push @tests, { push @tests, { nickname => 'sub with simple lexical modified elsewhere', generator => sub { my $x = 5; my $ret = sub(){$x}; $x = 7; $ret }, - retval => 5, # change to 7 when the deprecation cycle is over - same_retval => 0, - inlinable => 1, - deprecated => 1, - method => 0, + exception => $exception_134138, }; push @tests, { @@ -184,11 +185,7 @@ push @tests, { my $sub1 = sub () { $x++ }; $ret; }, - retval => 5, - same_retval => 0, - inlinable => 1, - deprecated => 1, - method => 0, + exception => $exception_134138, }; push @tests, { nickname => 'complex lexical op tree before an lvalue closure', @@ -307,11 +304,7 @@ push @tests, { eval '$outer++'; $ret; }, - retval => 43, - same_retval => 0, - inlinable => 1, - deprecated => 1, - method => 0, + exception => $exception_134138, }; push @tests, { nickname => 'sub () { $x } with s///ee in scope', @@ -322,11 +315,7 @@ push @tests, { $dummy =~ s//$dummy/ee; $ret; }, - retval => 43, - same_retval => 0, - inlinable => 1, - deprecated => 1, - method => 0, + exception => $exception_134138, }; push @tests, { nickname => 'sub () { $x } with eval not in scope', @@ -414,11 +403,7 @@ push @tests, { push @tests, { nickname => 'sub closing over state var++', generator => sub { state $x++; sub () { $x } }, - retval => 1, - same_retval => 0, - inlinable => 1, - deprecated => 1, - method => 0, + exception => $exception_134138, }; @@ -426,6 +411,12 @@ use feature 'refaliasing'; no warnings 'experimental::refaliasing'; for \%_ (@tests) { my $nickname = $_{nickname}; + if (exists $_{exception} and $_{exception}) { + local $@; + eval { my $sub = &{$_{generator}}; }; + like($@, qr/$_{exception}/, "$nickname: now throws exception (RT 134138)"); + next; + } my $w; local $SIG{__WARN__} = sub { $w = shift }; my $sub = &{$_{generator}}; @@ -492,3 +483,4 @@ pass("No assertion failure when turning on PADSTALE on lexical shared by" $z = &$sub; is $z, $y, 'inlinable sub ret vals are not swipable'; } + -- Perl5 Master Repository
