readline ARGV: don't try to open '|-' or '-|' and warn

This has no effect on in-place editing nor on the <<>> operator.

Later modified to ignore leading/internal/trailing space when
checking the name.

Fixes #21176

doio.c

@@ -1356,6 +1356,36 @@ static const MGVTBL argvout_vtbl =
         NULL /* svt_local */
     };
 
+static bool
+S_is_fork_open(const char *name) {
+    /* return true if name matches /^\A\s*(\|\s+-|\-\s+|)\s*\z/ */
+    while (isSPACE(*name))
+        name++;
+    if (*name == '|') {
+        ++name;
+        while (isSPACE(*name))
+            name++;
+        if (*name != '-')
+            return false;
+        ++name;
+    }
+    else if (*name == '-') {
+        ++name;
+        while (isSPACE(*name))
+            name++;
+        if (*name != '|')
+            return false;
+        ++name;
+    }
+    else
+        return false;
+
+    while (isSPACE(*name))
+        name++;
+
+    return *name == 0;
+}
+
 PerlIO *
 Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 {
@@ -1398,11 +1428,22 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
         SvSETMAGIC(GvSV(gv));
         PL_oldname = SvPVx(GvSV(gv), oldlen);
         if (LIKELY(!PL_inplace)) {
-            if (nomagicopen
-                    ? do_open6(gv, "<", 1, NULL, &GvSV(gv), 1)
-                    : do_open6(gv, PL_oldname, oldlen, NULL, NULL, 0)
-               ) {
-                return IoIFP(GvIOp(gv));
+            if (nomagicopen) {
+                if (do_open6(gv, "<", 1, NULL, &GvSV(gv), 1)) {
+                    return IoIFP(GvIOp(gv));
+                }
+            }
+            else {
+                if (is_fork_open(PL_oldname)) {
+                    Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
+                                     "Forked open '%s' not meaningful in <>",
+                                     PL_oldname);
+                    continue;
+                }
+
+                if ( do_open6(gv, PL_oldname, oldlen, NULL, NULL, 0) ) {
+                    return IoIFP(GvIOp(gv));
+                }
             }
         }
         else {

embed.fnc

@@ -4040,6 +4040,7 @@ S	|void	|exec_failed	|NN const char *cmd			\
 				|int do_report
 RS	|bool	|ingroup	|Gid_t testgid				\
 				|bool effective
+ST	|bool	|is_fork_open	|NN const char *name
 S	|bool	|openn_cleanup	|NN GV *gv				\
 				|NN IO *io				\
 				|NULLOK PerlIO *fp			\

embed.h

@@ -1162,6 +1162,7 @@
 #     define argvout_final(a,b,c)               S_argvout_final(aTHX_ a,b,c)
 #     define exec_failed(a,b,c)                 S_exec_failed(aTHX_ a,b,c)
 #     define ingroup(a,b)                       S_ingroup(aTHX_ a,b)
+#     define is_fork_open                       S_is_fork_open
 #     define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m)
 #     define openn_setup(a,b,c,d,e,f)           S_openn_setup(aTHX_ a,b,c,d,e,f)
 #   endif

pod/perldiag.pod

@@ -2619,6 +2619,13 @@ same name?
 iterate multiple values at a time. This syntax is currently experimental
 and its behaviour may change in future releases of Perl.
 
+=item Forked open '%s' not meaningful in <>
+
+(S inplace) You had C<|-> or C<-|> in C<@ARGV> and tried to use C<< <>
+>> to read from it.
+
+Previously this would fork and produce a confusing error message.
+
 =item Format not terminated
 
 (F) A format must be terminated by a line with a solitary dot.  Perl got

proto.h

@@ -6254,6 +6254,11 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective)
         __attribute__warn_unused_result__;
 # define PERL_ARGS_ASSERT_INGROUP
 
+STATIC bool
+S_is_fork_open(const char *name);
+# define PERL_ARGS_ASSERT_IS_FORK_OPEN          \
+        assert(name)
+
 STATIC bool
 S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *type, Stat_t *statbufp);
 # define PERL_ARGS_ASSERT_OPENN_CLEANUP         \

t/io/argv.t

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 37);
+plan(tests => 53);
 
 my ($devnull, $no_devnull);
 
@@ -252,6 +252,20 @@ close IN;
 unlink "tmpIo_argv3.tmp";
 **PROG**
 
+{
+    my $warn;
+    local $SIG{__WARN__} = sub { $warn = "@_" };
+    for my $op ("|-", "-|", "| -", "- |") {
+        for my $forked ($op, " $op", "$op ", " $op ") {
+            @ARGV = ( $forked );
+            undef $warn;
+            while (<>) {}
+            like($warn, qr/^Forked open '\Q$forked\E' not meaningful in <>/,
+                 "check for warning for $forked");
+        }
+    }
+}
+
 # This used to fail an assertion.
 # The tricks with *x and $x are to make PL_argvgv point to a freed SV when
 # the readline op does SvREFCNT_inc on it.  undef *x clears the scalar slot