In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/33fe1955034f86b7a9abfc24e0d45a5012030aeb?hp=5c5db62f010163c7c8a00f5b4aab243aacf62342>
- Log ----------------------------------------------------------------- commit 33fe1955034f86b7a9abfc24e0d45a5012030aeb Author: Lukas Mai <[email protected]> Date: Fri Nov 11 11:43:03 2016 +0100 make 'do' errors refer to 'do' (not 'require') (RT #129927) ----------------------------------------------------------------------- Summary of changes: pod/perldiag.pod | 7 ++++--- pp_ctl.c | 22 +++++++++++++--------- t/op/require_errors.t | 16 ++++++++++++++-- t/op/taint.t | 3 ++- 4 files changed, 33 insertions(+), 15 deletions(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b062043..7b8bfed 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3548,11 +3548,12 @@ can vary from one line to the next. (S syntax) This is an educated guess made in conjunction with the message "%s found where operator expected". Often the missing operator is a comma. -=item Missing or undefined argument to require +=item Missing or undefined argument to %s -(F) You tried to call require with no argument or with an undefined +(F) You tried to call require or do with no argument or with an undefined value as an argument. Require expects either a package name or a -file-specification as an argument. See L<perlfunc/require>. +file-specification as an argument; do expects a filename. See +L<perlfunc/require EXPR> and L<perlfunc/do EXPR>. =item Missing right brace on \%c{} in regex; marked by S<<-- HERE> in m/%s/ diff --git a/pp_ctl.c b/pp_ctl.c index 2f2a339..f7dd946 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3692,15 +3692,19 @@ S_require_file(pTHX_ SV *const sv) int saved_errno; bool path_searchable; I32 old_savestack_ix; + const bool op_is_require = PL_op->op_type == OP_REQUIRE; + const char *const op_name = op_is_require ? "require" : "do"; + + assert(op_is_require || PL_op->op_type == OP_DOFILE); if (!SvOK(sv)) - DIE(aTHX_ "Missing or undefined argument to require"); + DIE(aTHX_ "Missing or undefined argument to %s", op_name); name = SvPV_nomg_const(sv, len); if (!(name && len > 0 && *name)) - DIE(aTHX_ "Missing or undefined argument to require"); + DIE(aTHX_ "Missing or undefined argument to %s", op_name); - if (!IS_SAFE_PATHNAME(name, len, "require")) { - if (PL_op->op_type != OP_REQUIRE) { + if (!IS_SAFE_PATHNAME(name, len, op_name)) { + if (!op_is_require) { CLEAR_ERRSV(); RETPUSHUNDEF; } @@ -3709,7 +3713,7 @@ S_require_file(pTHX_ SV *const sv) NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0), Strerror(ENOENT)); } - TAINT_PROPER("require"); + TAINT_PROPER(op_name); path_searchable = path_is_searchable(name); @@ -3736,7 +3740,7 @@ S_require_file(pTHX_ SV *const sv) unixname = (char *) name; unixlen = len; } - if (PL_op->op_type == OP_REQUIRE) { + if (op_is_require) { SV * const * const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); if ( svp ) { @@ -3951,7 +3955,7 @@ S_require_file(pTHX_ SV *const sv) dirlen = 0; } - if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", "require")) + if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", op_name)) continue; #ifdef VMS if ((unixdir = @@ -4002,7 +4006,7 @@ S_require_file(pTHX_ SV *const sv) } # endif #endif - TAINT_PROPER("require"); + TAINT_PROPER(op_name); tryname = SvPVX_const(namesv); tryrsfp = doopen_pm(namesv); if (tryrsfp) { @@ -4028,7 +4032,7 @@ S_require_file(pTHX_ SV *const sv) saved_errno = errno; /* sv_2mortal can realloc things */ sv_2mortal(namesv); if (!tryrsfp) { - if (PL_op->op_type == OP_REQUIRE) { + if (op_is_require) { if(saved_errno == EMFILE || saved_errno == EACCES) { /* diag_listed_as: Can't locate %s */ DIE(aTHX_ "Can't locate %s: %s: %s", diff --git a/t/op/require_errors.t b/t/op/require_errors.t index 2bacf59..ca1622a 100644 --- a/t/op/require_errors.t +++ b/t/op/require_errors.t @@ -9,7 +9,7 @@ BEGIN { use strict; use warnings; -plan(tests => 23); +plan(tests => 27); my $nonfile = tempfile(); @@ -131,7 +131,7 @@ like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117 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'; + like $WARN, qr{^Invalid \\0 character in pathname for do: strict\.pm\\0invalid at }, 'do nulstring warning'; } $WARN = ''; @@ -156,3 +156,15 @@ like $@, qr/^Can't locate \(\?\^:\\0\):/, eval { no strict; no warnings 'syscalls'; require *{"\0a"} }; like $@, qr/^Can't locate \*main::\\0a:/, 'require ref that stringifies with embedded null'; + +eval { require undef }; +like $@, qr/^Missing or undefined argument to require /; + +eval { do undef }; +like $@, qr/^Missing or undefined argument to do /; + +eval { require "" }; +like $@, qr/^Missing or undefined argument to require /; + +eval { do "" }; +like $@, qr/^Missing or undefined argument to do /; diff --git a/t/op/taint.t b/t/op/taint.t index cf9055b..4d69498 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -17,7 +17,7 @@ BEGIN { use strict; use Config; -plan tests => 826; +plan tests => 828; $| = 1; @@ -1159,6 +1159,7 @@ violates_taint(sub { link $TAINT, '' }, 'link'); { my $foo = "imaginary library" . $TAINT; violates_taint(sub { require $foo }, 'require'); + violates_taint(sub { do $foo }, 'do'); my $filename = tempfile(); # NB: $filename isn't tainted! $foo = $filename . $TAINT; -- Perl5 Master Repository
