This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix read-only flag checks in lvalue sub exit
authorFather Chrysostomos <sprout@cpan.org>
Sat, 20 Sep 2014 13:55:39 +0000 (06:55 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 20 Sep 2014 16:25:02 +0000 (09:25 -0700)
See the previous commit for the explanation.  This fixes this
discrepancy:

$ ./miniperl -Ilib -e '+sub:lvalue{my $x = 3; Internals::SvREADONLY $x, 1; $x }->() = 3'
Can't return a readonly value from lvalue subroutine at -e line 1.
$ ./miniperl -Ilib -e '+sub:lvalue{my $x = *foo; Internals::SvREADONLY $x, 1; $x }->() = 3'
Modification of a read-only value attempted at -e line 1.

It was not just a flag check that this commit fixed, but also a bogus
SvREADONLY(TOPs) where TOPs may not even be the scalar we are dying
for, giving ‘a temporary’ for some read-only values.  That mistake was
my own, made in commit d25b0d7b8.

pp_ctl.c
t/op/sub_lval.t

index 7f60cce..e716fc7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2266,10 +2266,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
            const char *what = NULL;
            if (MARK < SP) {
                assert(MARK+1 == SP);
-               if ((SvPADTMP(TOPs) ||
-                    (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
-                      == SVf_READONLY
-                   ) &&
+               if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
                    !SvSMAGICAL(TOPs)) {
                    what =
                        SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
@@ -2337,11 +2334,9 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
        else while (++MARK <= SP) {
            if (*MARK != &PL_sv_undef
-                   && (SvPADTMP(*MARK)
-                      || (SvFLAGS(*MARK) & (SVf_READONLY|SVf_FAKE))
-                            == SVf_READONLY
-                      )
+                   && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
            ) {
+                   const bool ro = cBOOL( SvREADONLY(*MARK) );
                    SV *sv;
                    /* Might be flattened array after $#array =  */
                    PUTBACK;
@@ -2353,7 +2348,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
               /* diag_listed_as: Can't return %s from lvalue subroutine */
                    Perl_croak(aTHX_
                        "Can't return a %s from lvalue subroutine",
-                       SvREADONLY(TOPs) ? "readonly value" : "temporary");
+                        ro ? "readonly value" : "temporary");
            }
            else
                *++newsp =
index 4bd96ee..9b0ad06 100644 (file)
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>205;
+plan tests=>207;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -387,6 +387,19 @@ EOE
 
 like($_, qr/Can\'t return a readonly value from lvalue subroutine/);
 
+eval <<'EOF';
+  sub lv2tmpr : lvalue { my $x = *foo; Internals::SvREADONLY $x, 1; $x }
+  lv2tmpr = (2,3);
+EOF
+
+like($@, qr/Can\'t return a readonly value from lvalue subroutine at/);
+
+eval <<'EOG';
+  (lv2tmpr) = (2,3);
+EOG
+
+like($@, qr/Can\'t return a readonly value from lvalue subroutine/);
+
 sub lva : lvalue {@a}
 
 $_ = undef;