This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make sub(){42} return a mutable value
authorFather Chrysostomos <sprout@cpan.org>
Sun, 30 Jun 2013 21:51:37 +0000 (14:51 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:02 +0000 (23:48 -0700)
But only make it do so in lvalue context.  This will be just as fast
in true rvalue context.  In either case, it is still inlined.

This makes sub () { 42 } and sub () { return 42 } do the same thing.

It also means that sub () { '-'x75 } reverts back to returning a muta-
ble value, the way it did in 5.16.  From now on, tweaks to constant
folding will no longer affect the mutability of the return value of a
nullary function.

‘use constant’ is unaffected.  It still returns read-only values.

This was brought up in ticket #109744.

op.c
t/op/sub.t

diff --git a/op.c b/op.c
index a6312d3..ea1fe1c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7158,6 +7158,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
+       SvFLAGS(const_sv) = (SvFLAGS(const_sv) & ~SVs_PADMY) | SVs_PADTMP;
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            cv_forget_slab(cv);
@@ -7528,6 +7529,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     }
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
+       SvFLAGS(const_sv) = (SvFLAGS(const_sv) & ~SVs_PADMY) | SVs_PADTMP;
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            cv_forget_slab(cv);
index a160d46..3546880 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 21 );
+plan( tests => 23 );
 
 sub empty_sub {}
 
@@ -131,9 +131,14 @@ sub { is \$_[0], \$_[0],
 # The return statement should make no difference in this case:
 sub not_constant () {        42 }
 sub not_constantr() { return 42 }
+use feature 'lexical_subs'; no warnings 'experimental::lexical_subs';
+my sub not_constantm () {        42 }
+my sub not_constantmr() { return 42 }
 eval { ${\not_constant}++ };
-$::TODO = "not fixed yet";
 is $@, "", 'sub (){42} returns a mutable value';
-undef $::TODO;
 eval { ${\not_constantr}++ };
 is $@, "", 'sub (){ return 42 } returns a mutable value';
+eval { ${\not_constantm}++ };
+is $@, "", 'my sub (){42} returns a mutable value';
+eval { ${\not_constantmr}++ };
+is $@, "", 'my sub (){ return 42 } returns a mutable value';