[perl #24200] string corruption with lvalue sub

Depending on the context, the same substr OP may want to return
a PVLV or an LV on subsequent invcations. If TARG is the wrong
type, use a mortal instead.

p4raw-id: //depot/perl@22599

diff --git a/pp.c b/pp.c
index 4c3e377..0bf02fa 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3038,6 +3038,19 @@ PP(pp_substr)
        if (utf8_curlen)
            sv_pos_u2b(sv, &pos, &rem);
        tmps += pos;
+       /* we either return a PV or an LV. If the TARG hasn't been used
+        * before, or is of that type, reuse it; otherwise use a mortal
+        * instead. Note that LVs can have an extended lifetime, so also
+        * dont reuse if refcount > 1 (bug #20933) */
+       if (SvTYPE(TARG) > SVt_NULL) {
+           if ( (SvTYPE(TARG) == SVt_PVLV)
+                   ? (!lvalue || SvREFCNT(TARG) > 1)
+                   : lvalue)
+           {
+               TARG = sv_newmortal();
+           }
+       }
+
        sv_setpvn(TARG, tmps, rem);
 #ifdef USE_LOCALE_COLLATE
        sv_unmagic(TARG, PERL_MAGIC_collxfrm);
@@ -3074,8 +3087,6 @@ PP(pp_substr)
                    sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
            }
 
-           if (SvREFCNT(TARG) > 1)     /* don't share the TARG (#20933) */
-               TARG = sv_newmortal();
            if (SvTYPE(TARG) < SVt_PVLV) {
                sv_upgrade(TARG, SVt_PVLV);
                sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);

diff --git a/t/op/substr.t b/t/op/substr.t
index ad35dce..681ac6d 100755 (executable)
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..186\n";
+print "1..188\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -629,3 +629,14 @@ ok 174, $x eq "\x{100}\x{200}\xFFb";
        ok 186, $x eq 'aYYYYef';
     }
 }
+
+# [perl #24200] string corruption with lvalue sub
+
+{
+    my $foo = "a";
+    sub bar: lvalue { substr $foo, 0 }
+    bar = "XXX";
+    ok 187, bar eq 'XXX';
+    $foo = '123456789';
+    ok 188, bar eq '123456789';
+}