In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a1b60c8dae6ad00c164e20cf9151bae68e85ab2d?hp=4a59181454f23dbf43f396b924ff7434b63c9d98>
- Log ----------------------------------------------------------------- commit a1b60c8dae6ad00c164e20cf9151bae68e85ab2d Author: Lukas Mai <[email protected]> Date: Fri Oct 21 00:10:15 2016 +0200 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. ----------------------------------------------------------------------- Summary of changes: 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 88d4207..d27754e 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 0eb032d..7b8dc5b 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'; -- Perl5 Master Repository
