Skip to content

Commit

Permalink
pp_multiconcat: don't stringify LHS overload arg
Browse files Browse the repository at this point in the history
RT #132385

In something like

    $a1 . $a2

where $a2 is overloaded, the concat overload method was being called
like

    concat($a2, "$a1", 1);

(The 1 indicated that the args are reversed).

This commit changes it so that it's called as

    concat($a2, $a1, 1);

i.e. that the original arg is passed in rather than a stringified copy
of it. This is important if for example $a1 is a ref.
  • Loading branch information
iabyn committed Nov 4, 2017
1 parent b5af74d commit b3ab037
Show file tree
Hide file tree
Showing 2 changed files with 75 additions and 1 deletion.
41 changes: 40 additions & 1 deletion lib/overload.t
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ package main;

$| = 1;
BEGIN { require './test.pl'; require './charset_tools.pl' }
plan tests => 5326;
plan tests => 5331;

use Scalar::Util qw(tainted);

Expand Down Expand Up @@ -2995,3 +2995,42 @@ package Concat {
cc '$R.=sprintf("%s%s%s",$a,$B,$c)', 'RaBc', 1, '("",[B],u,)(.=,[R],aBc,u)'
.'("",[RaBc],u,)';
}

# RT #132385
# The first arg of a reversed concat shouldn't be stringified:
# $left . $right
# where $right is overloaded, should invoke
# concat($right, $left, 1)
# rather than
# concat($right, "$left", 1)

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 $r1 = [ "ref1" ];
my $r2 = [ "ref2" ];
my $s1 = "str1";

my $o = bless [ "obj" ];

# try variations that will call either pp_concat or pp_multiconcat,
# with the ref as the first or a later arg

::is($r1.$o, "ref1-obj", "RT #132385 r1.o");
::is($r1.$o.$s1 , "ref1-objstr1", "RT #132385 r1.o.s1");
::is("const".$o.$s1 ,"const-objstr1", "RT #132385 const.o.s1");
::is(C.$o.$s1 ,"constref-objstr1", "RT #132385 C.o.s1");

::like($r1.$r2.$o, qr/^ARRAY\(0x\w+\)ARRAY\(0x\w+\)-obj/,
"RT #132385 r1.r2.o");
}
35 changes: 35 additions & 0 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -520,6 +520,41 @@ PP(pp_multiconcat)
* FAKE implies an optimised sprintf which doesn't use
* concat overloading, only "" overloading.
*/

if ( svpv_end == svpv_buf + 1
/* no const string segments */
&& aux[PERL_MULTICONCAT_IX_LENGTHS].size == -1
&& aux[PERL_MULTICONCAT_IX_LENGTHS + 1].size == -1
) {
/* special case: if the overloaded sv is the
* second arg in the concat chain, stop at the
* first arg rather than this, so that
*
* $arg1 . $arg2
*
* invokes overloading as
*
* concat($arg2, $arg1, 1)
*
* rather than
*
* concat($arg2, "$arg1", 1)
*
* This means that if for example arg1 is a ref,
* it gets passed as-is to the concat method
* rather than a stringified copy. If it's not the
* first arg, it doesn't matter, as in $arg0 .
* $arg1 . $arg2, where the result of ($arg0 .
* $arg1) will already be a string.
* THis isn't perfect: we'll have already
* done SvPV($arg1) on the previous iteration;
* and are now throwing away that result and
* hoping arg1 hasn;t been affected.
*/
svpv_end--;
SP--;
}

setup_overload:
dsv = newSVpvn_flags("", 0, SVs_TEMP);

Expand Down

0 comments on commit b3ab037

Please sign in to comment.