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].

diff --git a/op.c b/op.c
index 1d31928..74de752 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10907,6 +10907,7 @@ Perl_ck_backtick(pTHX_ OP *o)
     OP *newop = NULL;
     OP *sibl;
     PERL_ARGS_ASSERT_CK_BACKTICK;
     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)))
     /* 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 5a0f7b5..b55cbda 100644 (file)
--- 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';
 
 my $Is_VMS   = $^O eq 'VMS';
 my $Is_Win32 = $^O eq 'MSWin32';
 

-plan(tests => 29);
+plan(tests => 38);

 
 my $Perl = which_perl();
 
 
 my $Perl = which_perl();
 


@@ -128,8 +128,29 @@ is( <<~`END`,                   "ok\n",     '<<~`HEREDOC`' );
   END
 
 {
   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 {
 }
 
 package o {