This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use concat overloading for "foo$_->$*"
authorFather Chrysostomos <sprout@cpan.org>
Tue, 17 May 2016 08:24:03 +0000 (01:24 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 17 May 2016 08:24:03 +0000 (01:24 -0700)
This is the only discrepancy between $$_ and $_->$* that I know about.

To get ->@... interpolation to work, we have to emit a special
POSTJOIN token, which has just the right precedence to get it to apply
to the right amount of code before it, which perly.y then turns into a
regular join(...).

->$* and ->$#* were also going through that same code path, though it
turns out that simply omitting the POSTJOIN token for these dollar
tokens Just Works.  (I thought the fix would be more complicated.)

Now $_->$* within quotes becomes a direct argument to the concat ope-
rator, instead of being wrapped in a stringify(...) (what join(...)
optimises to with a single-item list).

t/op/postfixderef.t
toke.c

index 77988bf..c3fa968 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict qw(refs subs);
 
 
 use strict qw(refs subs);
 
-plan(115);
+plan(116);
 
 {
     no strict 'refs';
 
 {
     no strict 'refs';
@@ -352,4 +352,16 @@ is "$_->@{foo}", "foo->7 8 9", '->@{ does not interpolate without feature';
     is "@{[foo->@*]}", "7 8 9", '->@* inside "@{...}"';
     is "@{[foo->@[0,1]]}", "7 8", '->@[ inside "@{...}"';
     is "@{[foo->@{foo}]}", "oof", '->@{ inside "@{...}"';
     is "@{[foo->@*]}", "7 8 9", '->@* inside "@{...}"';
     is "@{[foo->@[0,1]]}", "7 8", '->@[ inside "@{...}"';
     is "@{[foo->@{foo}]}", "oof", '->@{ inside "@{...}"';
+
+    # "foo $_->$*" should be equivalent to "foo $$_", which uses concat
+    # overloading
+    package o {
+       use overload fallback=>1,
+           '""' => sub { $_[0][0] },
+           '.'  => sub { bless [ "$_[$_[2]]"." plus "."$_[!$_[2]]" ] };
+    }
+    my $o = bless ["overload"], o::;
+    my $ref = \$o;
+    is "foo$ref->$*bar", "foo plus overload plus bar",
+       '"foo $s->$* bar" does concat overloading';
 }
 }
diff --git a/toke.c b/toke.c
index b16544b..70f00f3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1944,7 +1944,8 @@ S_postderef(pTHX_ int const funny, char const next)
        if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
            assert('@' == funny || '$' == funny || DOLSHARP == funny);
            PL_lex_state = LEX_INTERPEND;
        if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
            assert('@' == funny || '$' == funny || DOLSHARP == funny);
            PL_lex_state = LEX_INTERPEND;
-           force_next(POSTJOIN);
+           if ('@' == funny)
+               force_next(POSTJOIN);
        }
        force_next(next);
        PL_bufptr+=2;
        }
        force_next(next);
        PL_bufptr+=2;