In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/d7e75038064881b413f76de9315a5acfb21472f0?hp=04139aa0b51c7b5d9f80f77b10f85ce4c65a4cf6>
- Log ----------------------------------------------------------------- commit d7e75038064881b413f76de9315a5acfb21472f0 Author: David Mitchell <[email protected]> Date: Tue Nov 28 09:08:09 2017 +0000 $overloaded .= $x: don't stringify $x 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 ----------------------------------------------------------------------- Summary of changes: lib/overload.t | 18 ++++++++++++------ pp_hot.c | 13 +++++++++++++ 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/lib/overload.t b/lib/overload.t index 46b193be21..75a7aa2b32 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -48,7 +48,7 @@ package main; $| = 1; BEGIN { require './test.pl'; require './charset_tools.pl' } -plan tests => 5331; +plan tests => 5332; use Scalar::Util qw(tainted); @@ -3003,17 +3003,20 @@ package Concat { # 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 { - 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"); + + # ditto with a mutator + ::is($o .= $r1, "obj-ref1", "RT #132385 o.=r1"); } diff --git a/pp_hot.c b/pp_hot.c index d1d02257ed..7609638b8f 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -661,6 +661,19 @@ PP(pp_multiconcat) */ 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; } } -- Perl5 Master Repository
