open: only treat literal undef as special

Passing undef as the filename to open should create a temporary file.
Previously, this was implemented as a simple `if (arg == &PL_sv_undef)`
check. However, other operations (such as accessing non-existent
array/hash elements) also return `&PL_sv_undef` directly, which `open`
would then silently interpret as directions to create a temp file.

Solution: Check (at compile time) whether the filename argument is an
`OP_UNDEF`, and if so, set the `OPf_SPECIAL` flag on `OP_OPEN`. At
runtime, if `&PL_sv_undef` is passed but `OPf_SPECIAL` is not set,
replace it by a new mortal SV, which is treated as a regular filename
(that happens to be undef) by PerlIO.

(For runtime calls via `&CORE::open`, we cannot distinguish between
`undef` and `delete $hash{nosuchkey}` as arguments, so to keep the
`undef` case working, we always set `OPf_SPECIAL` in the generated core
sub for `open`.)

This functionality probably should be a private op flag (something like
`OPpUNDEF_MEANS_TEMPFILE`?), but as far as I can tell, all possible
private bits are already taken in `OP_OPEN`.

Fixes #22385.

Author: mauke

doio.c

@@ -849,6 +849,9 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
                 }
                 else {
                     if (num_svs) {
+                        if (*svp == &PL_sv_undef && PL_op && !(PL_op->op_flags & OPf_SPECIAL)) {
+                            *svp = sv_newmortal();
+                        }
                         fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
                     }
                     else {
@@ -884,6 +887,9 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
             }
             else {
                 if (num_svs) {
+                    if (*svp == &PL_sv_undef && PL_op && !(PL_op->op_flags & OPf_SPECIAL)) {
+                        *svp = sv_newmortal();
+                    }
                     fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
                 }
                 else {

op.c

@@ -13491,6 +13491,19 @@ Perl_ck_open(pTHX_ OP *o)
              (last == OpSIBLING(oa)))			/* The bareword. */
               last->op_private &= ~OPpCONST_STRICT;
     }
+    {
+        /* mark as special if filename is a literal undef */
+        const OP *arg = cLISTOPx(o)->op_first; /* pushmark */
+        if (
+            (arg = OpSIBLING(arg))    /* handle */
+            && (arg = OpSIBLING(arg)) /* mode */
+            && (arg = OpSIBLING(arg)) /* filename */
+        ) {
+            if (arg->op_type == OP_UNDEF && !(arg->op_flags & OPf_KIDS)) {
+                o->op_flags |= OPf_SPECIAL;
+            }
+        }
+    }
     return ck_fun(o);
 }
 
@@ -15679,7 +15692,19 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
             }
             return o;
         default:
-            o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
+            /* For open(), OPf_SPECIAL indicates we saw a literal undef as the
+             * filename argument and thus a &PL_sv_undef argument at runtime
+             * should trigger the creation of a temp file. This is to
+             * distinguish between open(..., ..., undef) and
+             * open(..., ..., delete $hash{key}), which also passes
+             * &PL_sv_undef if $hash{key} does not exist, but which should not
+             * create a temporary file.
+             * In case of a runtime call via &CORE::open(...) or
+             * my $f = \&CORE::open; $f->(...), we cannot distinguish between
+             * those cases. Therefore we always set the flag to interpret
+             * &PL_sv_undef as a temp file.
+             */
+            o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB || opnum == OP_OPEN),argop);
             if (is_handle_constructor(o, 2))
                 argop->op_private |= OPpCOREARGS_DEREF2;
             if (opnum == OP_SUBSTR) {

op.h

@@ -164,6 +164,8 @@ Deprecated.  Use C<GIMME_V> instead.
                                 /*  On OP_RETURN, module_true is in effect */
                                 /*  On OP_NEXT/OP_LAST/OP_REDO, there is no
                                  *  loop label */
+                                /*  On OP_OPEN, create a temporary file if the
+                                 *  filename argument is &PL_sv_undef */
 /* There is no room in op_flags for this one, so it has its own bit-
    field member (op_folded) instead.  The flag is only used to tell
    op_convert_list to set op_folded.  */

t/io/perlio_open.t

@@ -11,7 +11,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan tests => 10;
+plan tests => 16;
 
 use Fcntl qw(:seek);
 
@@ -43,4 +43,27 @@ SKIP:
     is($data, "abcxyz", "check the second write appended");
 }
 
+{
+    my $fn = \&CORE::open;
+    ok($fn->(my $fh, "+>", undef), "(\\&CORE::open)->(my \$fh, '+>', undef)");
+    print $fh "the right write stuff";
+    ok(seek($fh, 0, SEEK_SET), "seek to zero");
+    my $data = <$fh>;
+    is($data, "the right write stuff", "found the right stuff");
+}
 
+{
+    # GH #22385
+    my %hash;
+    my $warnings = '';
+    local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+    my $r = open my $fh, "+>", delete $hash{nosuchkey};
+    my $enoent = $!{ENOENT};
+    is $r, undef, "open(my \$fh, '+>', delete \$hash{nosuchkey}) fails";
+    SKIP: {
+        skip "This system doesn't understand ENOENT", 1
+            unless exists $!{ENOENT};
+        ok $enoent, "\$! is ENOENT";
+    }
+    like $warnings, qr/^Use of uninitialized value in open/, "it warns about undef";
+}