Allow ->@ ->$ interpolation under postderef_qq feature

This turned out to be tricky.  Normally @ at the beginning of the
interpolated code signals to the lexer to emit ‘join($",’ immediately.
With "$_->@*" we would have to retract the $ _ -> tokens upon encoun-
tering @*, which we obviously cannot do.

Waiting until we reach the end of the interpolated text before emit-
ting anything could not work either, as it may contain BEGIN blocks
that affect the way part of the interpolated code is parsed.

So what we do is introduce an egregious or clever hack, depending on
how you look at it.

Normally, the lexer turns "@foo" into:

    stringify ( join ( $ " , @ foo ) )

(The " is a WORD token, representing a variable name.)

"$_" becomes:

    stringify ( $ _ )

We can turn "$_->@*" into:

    stringify ( $ _ -> @ * POSTJOIN )

Where POSTJOIN is a new lexer token with special handling that creates
a join op just the way join($", ...) does.

To make "foo$_->@*bar" work as well, we have to make POSTJOIN have
precedence just below ->, so that

    stringify ( "foo" . $ _ -> @ * POSTJOIN . "bar" )

(what the parser sees) is equivalent to:

    stringify ( "foo" . ( $ _ -> @ * POSTJOIN ) . "bar" )

1 files changed, 17 insertions, 2 deletions

diff --git a/toke.c b/toke.c
index 2619cc8364..88c4348cc3 100644
--- a/toke.c
+++ b/toke.c
@@ -379,6 +379,7 @@ static struct debug_tokens {
     { PLUGEXPR,		TOKENTYPE_OPVAL,	"PLUGEXPR" },
     { PLUGSTMT,		TOKENTYPE_OPVAL,	"PLUGSTMT" },
     { PMFUNC,		TOKENTYPE_OPVAL,	"PMFUNC" },
+    { POSTJOIN,		TOKENTYPE_NONE,		"POSTJOIN" },
     { POSTDEC,		TOKENTYPE_NONE,		"POSTDEC" },
     { POSTINC,		TOKENTYPE_NONE,		"POSTINC" },
     { POWOP,		TOKENTYPE_OPNUM,	"POWOP" },
@@ -2174,11 +2175,18 @@ S_postderef(pTHX_ char const funny, char const next)
     assert(strchr("*[{", next));
     if (next == '*') {
 	PL_expect = XOPERATOR;
+	if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
+	    assert('@' == funny || '$' == funny);
+	    PL_lex_state = LEX_INTERPEND;
+	    start_force(PL_curforce);
+	    force_next(POSTJOIN);
+	}
 	start_force(PL_curforce);
 	force_next(next);
 	PL_bufptr+=2;
     }
     else {
+	if ('@' == funny) PL_lex_dojoin = 2;
 	PL_expect = XOPERATOR;
 	PL_bufptr++;
     }
@@ -2634,7 +2642,7 @@ S_sublex_push(pTHX)
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
-    SAVEBOOL(PL_lex_dojoin);
+    SAVEI8(PL_lex_dojoin);
     SAVEI32(PL_lex_brackets);
     SAVEI32(PL_lex_allbrackets);
     SAVEI32(PL_lex_formbrack);
@@ -3937,6 +3945,7 @@ S_scan_const(pTHX_ char *start)
  * It deals with "$foo[3]" and /$foo[3]/ and /$foo[0123456789$]+/
  *
  * ->[ and ->{ return TRUE
+ * ->$* ->@* ->@[ and ->@{ return TRUE if postfix_interpolate is enabled
  * { and [ outside a pattern are always subscripts, so return TRUE
  * if we're outside a pattern and it's not { or [, then return FALSE
  * if we're in a pattern and the first char is a {
@@ -3962,6 +3971,11 @@ S_intuit_more(pTHX_ char *s)
 	return TRUE;
     if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
 	return TRUE;
+    if (*s == '-' && s[1] == '>'
+     && FEATURE_POSTDEREF_QQ_IS_ENABLED
+     && ( (s[2] == '$' && s[3] == '*')
+	||(s[2] == '@' && strchr("*[{",s[3])) ))
+	return TRUE;
     if (*s != '{' && *s != '[')
 	return FALSE;
     if (!PL_lex_inpat)
@@ -5057,6 +5071,7 @@ Perl_yylex(pTHX)
 
     case LEX_INTERPEND:
 	if (PL_lex_dojoin) {
+	    const U8 dojoin_was = PL_lex_dojoin;
 	    PL_lex_dojoin = FALSE;
 	    PL_lex_state = LEX_INTERPCONCAT;
 #ifdef PERL_MAD
@@ -5067,7 +5082,7 @@ Perl_yylex(pTHX)
 	    }
 #endif
 	    PL_lex_allbrackets--;
-	    return REPORT(')');
+	    return REPORT(dojoin_was == 1 ? ')' : POSTJOIN);
 	}
 	if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
 	    && SvEVALED(PL_lex_repl))