properly check readpipe()'s argument list

readpipe() wasn't applying context to its argument list, resulting in
readpipe()'s context leaking in, and broken stack discipline when a list
expression was used.  Fixes [perl #4574].

(cherry picked from commit 397baf232086e0a9ad6f881a9614d3dbaea853fc)

2 files changed, 25 insertions, 3 deletions

diff --git a/op.c b/op.c
index 301acc6174..ae85a4783a 100644
--- a/op.c
+++ b/op.c
@@ -9332,6 +9332,7 @@ Perl_ck_backtick(pTHX_ OP *o)
     OP *newop = NULL;
     OP *sibl;
     PERL_ARGS_ASSERT_CK_BACKTICK;
+    o = ck_fun(o);
     /* qx and `` have a null pushmark; CORE::readpipe has only one kid. */
     if (o->op_flags & OPf_KIDS && (sibl = OpSIBLING(cUNOPo->op_first))
      && (gv = gv_override("readpipe",8)))
diff --git a/t/op/exec.t b/t/op/exec.t
index 325ccb2ace..726f5481d8 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C';		# Ditto in GNU.
 my $Is_VMS   = $^O eq 'VMS';
 my $Is_Win32 = $^O eq 'MSWin32';
 
-plan(tests => 24);
+plan(tests => 33);
 
 my $Perl = which_perl();
 
@@ -124,8 +124,29 @@ $Perl -le "print 'ok'"
 END
 
 {
-    local $_ = qq($Perl -le "print 'ok'");
-    is( readpipe, "ok\n", 'readpipe default argument' );
+    sub rpecho { qq($Perl -le "print '$_[0]'") }
+    is scalar(readpipe(rpecho("b"))), "b\n",
+	"readpipe with one argument in scalar context";
+    is join(",", "a", readpipe(rpecho("b")), "c"), "a,b\n,c",
+	"readpipe with one argument in list context";
+    local $_ = rpecho("f");
+    is scalar(readpipe), "f\n",
+	"readpipe default argument in scalar context";
+    is join(",", "a", readpipe, "c"), "a,f\n,c",
+	"readpipe default argument in list context";
+    sub rpechocxt {
+	rpecho(wantarray ? "list" : defined(wantarray) ? "scalar" : "void");
+    }
+    is scalar(readpipe(rpechocxt())), "scalar\n",
+	"readpipe argument context in scalar context";
+    is join(",", "a", readpipe(rpechocxt()), "b"), "a,scalar\n,b",
+	"readpipe argument context in list context";
+    foreach my $args ("(\$::p,\$::q)", "((\$::p,\$::q))") {
+	foreach my $lvalue ("my \$r", "my \@r") {
+	    eval("$lvalue = readpipe$args if 0");
+	    like $@, qr/\AToo many arguments for /;
+	}
+    }
 }
 
 package o {