Fix qx, `` and <<`` overrides

This resolves two RT tickets:
• #115330 is that qx and `` overrides do not support interpolation.
• #119827 is that <<`` does not support readpipe overrides at all.

The obvious fix for #115330 fixes #119827 at the same time.

When quote-like operators are parsed, after the string has been
scanned S_sublex_push is called, which decides which of two paths
to follow:
1) For things not requiring interpolation, the string is passed to
   tokeq (originally called q, it handles double backslashes and back-
   slashed delimiters) and returned to the parser immediately.
2) For anything that interpolates, the lexer enters a special inter-
   polation mode (LEX_INTERPPUSH) and goes through a more complex
   sequence over the next few calls (e.g., qq"a.$b.c" is turned into
  ‘stringify ( "a." . $ b . ".c" )’).

When commit e3f73d4ed (Oct 2006, perl 5.10) added support for overrid-
ing `` and qx with a readpipe sub, it did so by creating an entersub
op in toke.c and making S_sublex_push follow path no. 1, taking the
result if tokeq and inserting it into the already-constructed op tree
for the sub call.

That approach caused interpolation to be skipped when qx or `` is
overridden.  Furthermore it didn’t touch <<`` at all.

The easiest solution is to let toke.c follow its normal path and
create a backtick op (instead of trying to half-intercept it), and
to deal with override lookup afterwards in ck_backtick, the same way
require overrides are handled.  Since <<`` also turns into a backtick
op, it gets handled too that way.

1 files changed, 16 insertions, 3 deletions

diff --git a/op.c b/op.c
index fb214d90b4..f9ec7aa019 100644
--- a/op.c
+++ b/op.c
@@ -8442,10 +8442,22 @@ S_io_hints(pTHX_ OP *o)
 OP *
 Perl_ck_backtick(pTHX_ OP *o)
 {
+    GV *gv;
+    OP *newop = NULL;
     PERL_ARGS_ASSERT_CK_BACKTICK;
-    S_io_hints(aTHX_ o);
-    if (!(o->op_flags & OPf_KIDS)) {
-	OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+    /* qx and `` have a null pushmark; CORE::readpipe has only one kid. */
+    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_sibling
+     && (gv = gv_override("readpipe",8))) {
+	newop = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			op_append_elem(OP_LIST,
+				       cUNOPo->op_first->op_sibling,
+				       newCVREF(0, newGVOP(OP_GV, 0, gv))
+				      ));
+	cUNOPo->op_first->op_sibling = NULL;
+    }
+    else if (!(o->op_flags & OPf_KIDS))
+	newop = newUNOP(OP_BACKTICK, 0,	newDEFSVOP());
+    if (newop) {
 #ifdef PERL_MAD
 	op_getmad(o,newop,'O');
 #else
@@ -8453,6 +8465,7 @@ Perl_ck_backtick(pTHX_ OP *o)
 #endif
 	return newop;
     }
+    S_io_hints(aTHX_ o);
     return o;
 }