[perl.git] branch blead updated. v5.27.6-204-g397baf2320

[Zefram]

In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/397baf232086e0a9ad6f881a9614d3dbaea853fc?hp=0165f7b01e9c43629d0c6f4b5eb2e672abeda51a>

- Log -----------------------------------------------------------------
commit 397baf232086e0a9ad6f881a9614d3dbaea853fc
Author: Zefram <zef...@fysh.org>
Date:   Tue Dec 12 06:24:01 2017 +0000

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

-----------------------------------------------------------------------

Summary of changes:
 op.c        |  1 +
 t/op/exec.t | 27 ++++++++++++++++++++++++---
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/op.c b/op.c
index 1d31928882..74de752405 100644
--- 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;
+    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 5a0f7b5601..b55cbda09c 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 => 29);
+plan(tests => 38);
 
 my $Perl = which_perl();
 
@@ -128,8 +128,29 @@ is( <<~`END`,                   "ok\n",     '<<~`HEREDOC`' 
);
   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 {

-- 
Perl5 Master Repository