This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$overloaded .= $x: don't stringify $x
authorDavid Mitchell <davem@iabyn.com>
Tue, 28 Nov 2017 09:08:09 +0000 (09:08 +0000)
committerDavid Mitchell <davem@iabyn.com>
Tue, 28 Nov 2017 09:23:57 +0000 (09:23 +0000)
RT #132385

This is a variant of the ($ref . $overloaded) bug which was fixed with
v5.27.5-195-gb3ab0375cb.

Basically, when the overloaded concat method is called, it should pass
$x as-is, rather than as "$x". This fixes PDL-2.018

lib/overload.t
pp_hot.c

index 46b193b..75a7aa2 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl'; require './charset_tools.pl' }
 
 $| = 1;
 BEGIN { require './test.pl'; require './charset_tools.pl' }
-plan tests => 5331;
+plan tests => 5332;
 
 use Scalar::Util qw(tainted);
 
 
 use Scalar::Util qw(tainted);
 
@@ -3003,17 +3003,20 @@ package Concat {
 #      concat($right, $left, 1)
 #  rather than
 #      concat($right, "$left", 1)
 #      concat($right, $left, 1)
 #  rather than
 #      concat($right, "$left", 1)
+# There's a similar issue with
+#      $left .= $right
+# when left is overloaded
 
 package RT132385 {
 
     use constant C => [ "constref" ];
 
     use overload '.' => sub {
 
 package RT132385 {
 
     use constant C => [ "constref" ];
 
     use overload '.' => sub {
-                            my ($r, $l, $rev) = @_;
-                            die "expected reverse\n" unless $rev;
-                            my $res = ref $l ? $l->[0] : "$l";
-                            $res .= "-" . $r->[0];
-                            $res;
+                            my ($l, $r, $rev) = @_;
+                            ($l,$r) = ($r,$l) if $rev;
+                            $l = ref $l ? $l->[0] : "$l";
+                            $r = ref $r ? $r->[0] : "$r";
+                            "$l-$r";
                         }
     ;
 
                         }
     ;
 
@@ -3033,4 +3036,7 @@ package RT132385 {
 
     ::like($r1.$r2.$o,   qr/^ARRAY\(0x\w+\)ARRAY\(0x\w+\)-obj/,
                                                 "RT #132385 r1.r2.o");
 
     ::like($r1.$r2.$o,   qr/^ARRAY\(0x\w+\)ARRAY\(0x\w+\)-obj/,
                                                 "RT #132385 r1.r2.o");
+
+    # ditto with a mutator
+    ::is($o .= $r1,     "obj-ref1",             "RT #132385 o.=r1");
 }
 }
index d1d0225..7609638 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -661,6 +661,19 @@ PP(pp_multiconcat)
                  */
                 assert(!targ_chain);
                 dsv = newSVpvn_flags("", 0, SVs_TEMP);
                  */
                 assert(!targ_chain);
                 dsv = newSVpvn_flags("", 0, SVs_TEMP);
+
+                if (   svpv_end == svpv_buf + 1
+                       /* no const string segments */
+                    && aux[PERL_MULTICONCAT_IX_LENGTHS].ssize == -1
+                ) {
+                    /* special case $overloaded .= $arg1:
+                     * avoid stringifying $arg1.
+                     * Similar to the $arg1 . $arg2 case in phase1
+                     */
+                    svpv_end--;
+                    SP--;
+                }
+
                 goto phase3;
             }
         }
                 goto phase3;
             }
         }