In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/686c4ca09cf9d6ae455bf0a013551e92f00e34fe?hp=d4f686ebcef0088965d36d72f49b680287c377a2>
- Log ----------------------------------------------------------------- commit 686c4ca09cf9d6ae455bf0a013551e92f00e34fe Author: Nicholas Clark <[email protected]> Date: Tue Jun 29 17:23:41 2010 +0100 Reinstate require error messages for .h and .ph These had been present since 5.000, but were inadvertently removed by the refactoring b8f04b1b779ce1df. Yes, files matching /.*.h\z/ get two pieces of advice in the error message, but this was the exact behaviour pre-b8f04b1b779ce1df. M MANIFEST M pp_ctl.c A t/op/require_errors.t commit ec72681b3d7714d33bccdc5be6f31b5db25f9c90 Author: Nicholas Clark <[email protected]> Date: Tue Jun 29 16:17:19 2010 +0100 In pp_require, avoid changing PL_compiling if we're not about to compile. The original code order has existed since 5.000, and I think the change around perl-5.003_97h to C<tryrsfp ? tryname : name> cured symptoms rather than the underlying cause. M pp_ctl.c commit c5f55552f590f25c85de98dc513dcb8287bdbc0f Author: Nicholas Clark <[email protected]> Date: Tue Jun 29 14:29:23 2010 +0100 In pp_require and code refs in @INC, avoid using memory after free(). d8723a6a74b2c12e wasn't perfect, as the char * returned by SvPV*() can be a temporary, freed at the next FREETMPS. There is a FREETMPS in pp_require, so move the SvPV*() after it. M pp_ctl.c M t/op/incfilter.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + pp_ctl.c | 23 +++++++++++++---------- t/op/incfilter.t | 14 +++++++++++++- t/op/require_errors.t | 35 +++++++++++++++++++++++++++++++++++ 4 files changed, 62 insertions(+), 11 deletions(-) create mode 100644 t/op/require_errors.t diff --git a/MANIFEST b/MANIFEST index 3452fcc..4363cd5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4494,6 +4494,7 @@ t/op/read.t See if read() works t/op/recurse.t See if deep recursion works t/op/ref.t See if refs and objects work t/op/repeat.t See if x operator works +t/op/require_errors.t See if errors from require are reported correctly t/op/reset.t See if reset operator works t/op/reverse.t See if reverse operator works t/op/runlevel.t See if die() works from perl_call_*() diff --git a/pp_ctl.c b/pp_ctl.c index 28fc6ff..8134187 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3468,11 +3468,6 @@ PP(pp_require) count = call_sv(loader, G_ARRAY); SPAGAIN; - /* Adjust file name if the hook has set an %INC entry */ - svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); - if (svp) - tryname = SvPV_nolen_const(*svp); - if (count > 0) { int i = 0; SV *arg; @@ -3534,6 +3529,12 @@ PP(pp_require) FREETMPS; LEAVE_with_name("call_INC"); + /* Adjust file name if the hook has set an %INC entry. + This needs to happen after the FREETMPS above. */ + svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); + if (svp) + tryname = SvPV_nolen_const(*svp); + if (tryrsfp) { hook_sv = dirsv; break; @@ -3626,8 +3627,10 @@ PP(pp_require) } } } - SAVECOPFILE_FREE(&PL_compiling); - CopFILE_set(&PL_compiling, tryrsfp ? tryname : name); + if (tryrsfp) { + SAVECOPFILE_FREE(&PL_compiling); + CopFILE_set(&PL_compiling, tryname); + } SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { @@ -3644,9 +3647,9 @@ PP(pp_require) SV * const msg = sv_2mortal(Perl_newSVpvf(aTHX_ "%s in @INC%s%s (@INC contains:", msgstr, - (instr(msgstr, ".h ") - ? " (change .h to .ph maybe?)" : ""), - (instr(msgstr, ".ph ") + (memEQ(name + len - 2, ".h", 3) + ? " (change .h to .ph maybe?) (did you run h2ph?)" : ""), + (memEQ(name + len - 3, ".ph", 4) ? " (did you run h2ph?)" : "") )); diff --git a/t/op/incfilter.t b/t/op/incfilter.t index f796275..7b09966 100644 --- a/t/op/incfilter.t +++ b/t/op/incfilter.t @@ -19,7 +19,7 @@ use strict; use Config; use Filter::Util::Call; -plan(tests => 141); +plan(tests => 143); unshift @INC, sub { no warnings 'uninitialized'; @@ -221,3 +221,15 @@ do [\'pa', \&generator_with_state, ["ss('And generators which take state');\n", "pass('And return multiple lines');\n", ]] or die; + +# d8723a6a74b2c12e wasn't perfect, as the char * returned by SvPV*() can be +# a temporary, freed at the next FREETMPS. And there is a FREETMPS in +# pp_require + +for (0 .. 1) { + # Need both alternatives on the regexp, because currently the logic in + # pp_require for what is written to %INC is somewhat confused + open $fh, "<", + \'like(__FILE__, qr/(?:GLOB|CODE)\(0x[0-9a-f]+\)/, "__FILE__ is valid");'; + do $fh or die; +} diff --git a/t/op/require_errors.t b/t/op/require_errors.t new file mode 100644 index 0000000..23df8b1 --- /dev/null +++ b/t/op/require_errors.t @@ -0,0 +1,35 @@ +#!perl +use strict; +use warnings; + +BEGIN { + require './test.pl'; +} + +plan(tests => 3); + +my $nonfile = tempfile(); + +...@inc = qw(Perl Rules); + +eval { + require $nonfile; +}; + +like $@, qr/^Can't locate $nonfile in \...@inc \(\...@inc contains: @INC\) at/; + +eval { + require "$nonfile.ph"; +}; + +like $@, qr/^Can't locate $nonfile\.ph in \...@inc \(did you run h2ph\?\) \(\...@inc contains: @INC\) at/; + +eval { + require "$nonfile.h"; +}; + +like $@, qr/^Can't locate $nonfile\.h in \...@inc \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\...@inc contains: @INC\) at/; + +# I can't see how to test the EMFILE case +# I can't see how to test the case of not displaying @INC in the message. +# (and does that only happen on VMS?) -- Perl5 Master Repository
