Skip to content

Commit 42a1fdc

Browse files
committed
Revert "open: only treat literal undef as special"
This reverts commit 471c834 but also adds a test which the reverted code would not pass and a perldelta item.
1 parent ab79bb2 commit 42a1fdc

File tree

5 files changed

+28
-57
lines changed

5 files changed

+28
-57
lines changed

doio.c

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -845,9 +845,6 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
845845
}
846846
else {
847847
if (num_svs) {
848-
if (*svp == &PL_sv_undef && PL_op && !(PL_op->op_flags & OPf_SPECIAL)) {
849-
*svp = sv_newmortal();
850-
}
851848
fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
852849
}
853850
else {
@@ -883,9 +880,6 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
883880
}
884881
else {
885882
if (num_svs) {
886-
if (*svp == &PL_sv_undef && PL_op && !(PL_op->op_flags & OPf_SPECIAL)) {
887-
*svp = sv_newmortal();
888-
}
889883
fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
890884
}
891885
else {

op.c

Lines changed: 1 addition & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -13901,19 +13901,6 @@ Perl_ck_open(pTHX_ OP *o)
1390113901
last->op_private &= ~OPpCONST_STRICT;
1390213902
}
1390313903
}
13904-
{
13905-
/* mark as special if filename is a literal undef */
13906-
const OP *arg = cLISTOPx(o)->op_first; /* pushmark */
13907-
if (
13908-
(arg = OpSIBLING(arg)) /* handle */
13909-
&& (arg = OpSIBLING(arg)) /* mode */
13910-
&& (arg = OpSIBLING(arg)) /* filename */
13911-
) {
13912-
if (arg->op_type == OP_UNDEF && !(arg->op_flags & OPf_KIDS)) {
13913-
o->op_flags |= OPf_SPECIAL;
13914-
}
13915-
}
13916-
}
1391713904
return ck_fun(o);
1391813905
}
1391913906

@@ -16113,19 +16100,7 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
1611316100
}
1611416101
return o;
1611516102
default:
16116-
/* For open(), OPf_SPECIAL indicates we saw a literal undef as the
16117-
* filename argument and thus a &PL_sv_undef argument at runtime
16118-
* should trigger the creation of a temp file. This is to
16119-
* distinguish between open(..., ..., undef) and
16120-
* open(..., ..., delete $hash{key}), which also passes
16121-
* &PL_sv_undef if $hash{key} does not exist, but which should not
16122-
* create a temporary file.
16123-
* In case of a runtime call via &CORE::open(...) or
16124-
* my $f = \&CORE::open; $f->(...), we cannot distinguish between
16125-
* those cases. Therefore we always set the flag to interpret
16126-
* &PL_sv_undef as a temp file.
16127-
*/
16128-
o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB || opnum == OP_OPEN),argop);
16103+
o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
1612916104
if (is_handle_constructor(o, 2))
1613016105
argop->op_private |= OPpCOREARGS_DEREF2;
1613116106
if (opnum == OP_SUBSTR) {

op.h

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -164,8 +164,6 @@ Deprecated. Use C<GIMME_V> instead.
164164
/* On OP_RETURN, module_true is in effect */
165165
/* On OP_NEXT/OP_LAST/OP_REDO, there is no
166166
* loop label */
167-
/* On OP_OPEN, create a temporary file if the
168-
* filename argument is &PL_sv_undef */
169167
/* There is no room in op_flags for this one, so it has its own bit-
170168
field member (op_folded) instead. The flag is only used to tell
171169
op_convert_list to set op_folded. */

pod/perldelta.pod

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -395,6 +395,28 @@ reading and that error is C<EAGAIN> or C<EWOULDBLOCK>. This allows
395395
old code that depended on C<readline> to clear all errors to ignore
396396
these relatively harmless errors. [GH #22883]
397397

398+
=item *
399+
400+
L<C<open>|perlfunc/open> automatically creates an anonymous temporary file
401+
when passed C<undef> as a filename:
402+
403+
open(my $fh, "+>", undef) or die ...
404+
405+
This is supposed to work only when the undefined value is the one returned by
406+
the C<undef> function.
407+
408+
In perls before 5.41.3, this caused a problem due to the fact that the same
409+
undefined value can be generated by lookups of non-existent hash keys or array
410+
elements, which can lead to bugs in user-level code (reported as [GH #22385]).
411+
412+
In 5.41.3, additional checks based on the syntax tree of the call site were
413+
added, which fixed this issue for some number of common cases, though not all
414+
of them, at the cost of breaking the ability of APIs that wrap C<open> to
415+
expose its anonymous file mode. A notable example of such an API is autodie.
416+
417+
This release reverts to the old problem in preference to the new one for the
418+
time being.
419+
398420
=back
399421

400422
=head1 Known Problems

t/io/perlio_open.t

Lines changed: 5 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ BEGIN {
1111
use strict;
1212
use warnings;
1313

14-
plan tests => 16;
14+
plan tests => 11;
1515

1616
use Fcntl qw(:seek);
1717

@@ -44,26 +44,8 @@ SKIP:
4444
}
4545

4646
{
47-
my $fn = \&CORE::open;
48-
ok($fn->(my $fh, "+>", undef), "(\\&CORE::open)->(my \$fh, '+>', undef)");
49-
print $fh "the right write stuff";
50-
ok(seek($fh, 0, SEEK_SET), "seek to zero");
51-
my $data = <$fh>;
52-
is($data, "the right write stuff", "found the right stuff");
53-
}
54-
55-
{
56-
# GH #22385
57-
my %hash;
58-
my $warnings = '';
59-
local $SIG{__WARN__} = sub { $warnings .= $_[0] };
60-
my $r = open my $fh, "+>", delete $hash{nosuchkey};
61-
my $enoent = $!{ENOENT};
62-
is $r, undef, "open(my \$fh, '+>', delete \$hash{nosuchkey}) fails";
63-
SKIP: {
64-
skip "This system doesn't understand ENOENT", 1
65-
unless exists $!{ENOENT};
66-
ok $enoent, "\$! is ENOENT";
67-
}
68-
like $warnings, qr/^Use of uninitialized value in open/, "it warns about undef";
47+
# minimal-reproduction moral equivalent of the autodie wrapper for open()
48+
# because APIs that wrap open() should be able to expose this behaviour
49+
sub wrapped_open (*;$@) { open $_[0], $_[1], $_[2] }
50+
ok((wrapped_open my $fh, "+>", undef), "wrapped_open my \$fh, '+>', undef");
6951
}

0 commit comments

Comments
 (0)