mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Revert "open: only treat literal undef as special"

Browse Source 
This reverts commit 471c834070f1d22c4f2dc1c9997a5adfd959f3e5 but also
adds a test which the reverted code would not pass and a perldelta item.
This commit is contained in:
Aristotle Pagaltzis 2025-05-23 07:21:12 +02:00
parent 611bdf005f
commit 79d4169d02
5 changed files with 28 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
doio.c
View File

@ -845,9 +845,6 @@ 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 {
@ -883,9 +880,6 @@ 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 {

27
op.c
View File

@ -13901,19 +13901,6 @@ Perl_ck_open(pTHX_ OP *o)
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);
}
@ -16113,19 +16100,7 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
}
return o;
default:
/* 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);
o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
if (is_handle_constructor(o, 2))
argop->op_private |= OPpCOREARGS_DEREF2;
if (opnum == OP_SUBSTR) {

2
op.h
View File

@ -164,8 +164,6 @@ 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. */

22
pod/perldelta.pod
View File

@ -395,6 +395,28 @@ reading and that error is C<EAGAIN> or C<EWOULDBLOCK>. This allows
old code that depended on C<readline> to clear all errors to ignore
these relatively harmless errors. [GH #22883]
=item *
L<C<open>|perlfunc/open> automatically creates an anonymous temporary file
when passed C<undef> as a filename:
open(my $fh, "+>", undef) or die ...
This is supposed to work only when the undefined value is the one returned by
the C<undef> function.
In perls before 5.41.3, this caused a problem due to the fact that the same
undefined value can be generated by lookups of non-existent hash keys or array
elements, which can lead to bugs in user-level code (reported as [GH #22385]).
In 5.41.3, additional checks based on the syntax tree of the call site were
added, which fixed this issue for some number of common cases, though not all
of them, at the cost of breaking the ability of APIs that wrap C<open> to
expose its anonymous file mode. A notable example of such an API is autodie.
This release reverts to the old problem in preference to the new one for the
time being.
=back
=head1 Known Problems

28
t/io/perlio_open.t
View File

@ -11,7 +11,7 @@ BEGIN {
use strict;
use warnings;
plan tests => 16;
plan tests => 11;
use Fcntl qw(:seek);
@ -44,26 +44,8 @@ SKIP:
}
{
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";
# minimal-reproduction moral equivalent of the autodie wrapper for open()
# because APIs that wrap open() should be able to expose this behaviour
sub wrapped_open (*;$@) { open $_[0], $_[1], $_[2] }
ok((wrapped_open my $fh, "+>", undef), "wrapped_open my \$fh, '+>', undef");
}