New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
do "a\0b" dies instead of returning undef / ENOENT #15676
Comments
From @maukeCreated by @maukeperldoc -f do: | If "do" cannot read the file, it returns undef and sets $! to the $ perl -we 'open my $ perl -we 'do "a\0b" or warn "do failed with: $!"' When given a filename containing "\0", 'do' throws a "Can't locate" Perl Info
|
From @maukeOn Thu Oct 20 12:00:22 2016, mauke- wrote:
Patch attached. |
From @mauke0001-make-do-a-0b-fail-silently-instead-of-throwing-RT-12.patchFrom c73c31dd573882e99184c56f3f5aac526208cb6b Mon Sep 17 00:00:00 2001
From: Lukas Mai <l.mai@web.de>
Date: Fri, 21 Oct 2016 00:10:15 +0200
Subject: [PATCH] make do "a\0b" fail silently instead of throwing (RT #129928)
Also remove the label/goto from CLEAR_ERRSV because labels have function
scope, which means you couldn't use CLEAR_ERRSV more than once per
function without getting a "duplicate label" error.
---
perl.h | 5 ++---
pp_ctl.c | 4 ++++
t/op/require_errors.t | 16 +++++++++++++---
3 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/perl.h b/perl.h
index d27a131..175dc2e 100644
--- a/perl.h
+++ b/perl.h
@@ -1280,14 +1280,13 @@ EXTERN_C char *crypt(const char *, const char *);
#define CLEAR_ERRSV() STMT_START { \
SV ** const svp = &GvSV(PL_errgv); \
if (!*svp) { \
- goto clresv_newemptypv; \
+ *svp = newSVpvs(""); \
} else if (SvREADONLY(*svp)) { \
SvREFCNT_dec_NN(*svp); \
- clresv_newemptypv: \
*svp = newSVpvs(""); \
} else { \
SV *const errsv = *svp; \
- SvPVCLEAR(errsv); \
+ SvPVCLEAR(errsv); \
SvPOK_only(errsv); \
if (SvMAGICAL(errsv)) { \
mg_free(errsv); \
diff --git a/pp_ctl.c b/pp_ctl.c
index 8aa02d5..921d53f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3692,6 +3692,10 @@ S_require_file(pTHX_ SV *const sv)
DIE(aTHX_ "Missing or undefined argument to require");
if (!IS_SAFE_PATHNAME(name, len, "require")) {
+ if (PL_op->op_type != OP_REQUIRE) {
+ CLEAR_ERRSV();
+ RETPUSHUNDEF;
+ }
DIE(aTHX_ "Can't locate %s: %s",
pv_escape(newSVpvs_flags("",SVs_TEMP),name,len,len*2,
NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0),
diff --git a/t/op/require_errors.t b/t/op/require_errors.t
index d2c2bb5..2bacf59 100644
--- a/t/op/require_errors.t
+++ b/t/op/require_errors.t
@@ -9,7 +9,7 @@ BEGIN {
use strict;
use warnings;
-plan(tests => 20);
+plan(tests => 23);
my $nonfile = tempfile();
@@ -120,11 +120,21 @@ SKIP: {
# fail and print the full filename
eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]';
-eval { no warnings 'syscalls'; do "strict.pm\0invalid"; };
-like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'do nul check';
{
my $WARN;
local $SIG{__WARN__} = sub { $WARN = shift };
+ {
+ my $ret = do "strict.pm\0invalid";
+ my $exc = $@;
+ my $err = $!;
+ is $ret, undef, 'do nulstring returns undef';
+ is $exc, '', 'do nulstring clears $@';
+ $! = $err;
+ ok $!{ENOENT}, 'do nulstring fails with ENOENT';
+ like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'do nulstring warning';
+ }
+
+ $WARN = '';
eval { require "strict.pm\0invalid"; };
like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning';
like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error';
--
2.10.0
|
The RT System itself - Status changed from 'new' to 'open' |
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.26.0, this and 210 other issues have been Perl 5.26.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#129928 (status was 'resolved')
Searchable as RT129928$
The text was updated successfully, but these errors were encountered: