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/trailing space when checking
the name.

Fixes #21176

Author: tonycoz

doio.c

@@ -1358,6 +1358,23 @@ 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*\z/ */
+    while (isSPACE(*name))
+        name++;
+    if ((name[0] != '|' || name[1] != '-')
+        && (name[0] != '-' || name[1] != '|')) {
+        return false;
+    }
+    name +=  2;
+
+    while (isSPACE(*name))
+        name++;
+
+    return *name == 0;
+}
+
 PerlIO *
 Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 {
@@ -1400,11 +1417,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

@@ -4042,6 +4042,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

@@ -1163,6 +1163,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

@@ -2604,6 +2604,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

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 37);
+plan(tests => 45);
 
 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