In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e6c837f56971637e07a467eafee1c813287e20e0?hp=1f64ae15647e757e817c923b2a9fcbc528c5f610>
- Log ----------------------------------------------------------------- commit e6c837f56971637e07a467eafee1c813287e20e0 Author: Nicholas Clark <[email protected]> Date: Thu Jun 28 18:21:01 2012 +0200 Test that when directories in @INC are skipped, coderefs are still called. For filenames that are absolute, or start with ./ or ../ only coderefs in @INC are called - directories are skipped. Test this behaviour. M MANIFEST A t/lib/test_require.pm M t/op/inccode.t commit 2fc7dfcbbf2c319e5b0c6f61e4925c97d972274d Author: Nicholas Clark <[email protected]> Date: Wed Jun 27 18:25:50 2012 +0200 Avoid reading before the buffer start when generating errors from require. In pp_require, the error reporting code treats file names ending /\.p?h\z/ specially. The detection code for this, as refactored in 2010 by commit 686c4ca09cf9d6ae, could read one or two bytes before the start of the filename for filenames less than 3 bytes long. (Note this cannot happen with module names given to use or require, as appending ".pm" will always make the filename at least 3 bytes long.) M pp_ctl.c M t/op/require_errors.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + pp_ctl.c | 4 ++-- t/lib/test_require.pm | 6 ++++++ t/op/inccode.t | 25 ++++++++++++++++++++----- t/op/require_errors.t | 32 +++++++++++++++++++++++--------- 5 files changed, 52 insertions(+), 16 deletions(-) create mode 100644 t/lib/test_require.pm diff --git a/MANIFEST b/MANIFEST index d73e225..704b25f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5066,6 +5066,7 @@ t/lib/strict/refs Tests of "use strict 'refs'" for strict.t t/lib/strict/subs Tests of "use strict 'subs'" for strict.t t/lib/strict/vars Tests of "use strict 'vars'" for strict.t t/lib/subs/subs Tests of "use subs" +t/lib/test_require.pm A test file for t/op/inccode.t t/lib/test_use_14937.pm A test pragma for t/comp/use.t t/lib/test_use.pm A test pragma for t/comp/use.t t/lib/universal.t Tests for functions in universal.c diff --git a/pp_ctl.c b/pp_ctl.c index 1bec840..ca953ad 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3923,9 +3923,9 @@ PP(pp_require) DIE(aTHX_ "Can't locate %s in @INC%s%s (@INC contains:%" SVf ")", name, - (memEQ(name + len - 2, ".h", 3) + (len >= 2 && memEQ(name + len - 2, ".h", 3) ? " (change .h to .ph maybe?) (did you run h2ph?)" : ""), - (memEQ(name + len - 3, ".ph", 4) + (len >= 3 && memEQ(name + len - 3, ".ph", 4) ? " (did you run h2ph?)" : ""), inc ); diff --git a/t/lib/test_require.pm b/t/lib/test_require.pm new file mode 100644 index 0000000..381e068 --- /dev/null +++ b/t/lib/test_require.pm @@ -0,0 +1,6 @@ +#!perl -w +# Don't use strict because this is for testing require + +package test_require; + +++$test_require::loaded; diff --git a/t/op/inccode.t b/t/op/inccode.t index 44c9e89..d34e735 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -21,7 +21,7 @@ unless (is_miniperl()) { use strict; -plan(tests => 53 + !is_miniperl() * (3 + 14 * $can_fork)); +plan(tests => 60 + !is_miniperl() * (3 + 14 * $can_fork)); sub get_temp_fh { my $f = tempfile(); @@ -194,12 +194,27 @@ $ret ||= do 'abc.pl'; is( $ret, 'abc', 'do "abc.pl" sees return value' ); { - my $filename = './Foo.pm'; + my $got; #local @INC; # local fails on tied @INC my @old_INC = @INC; # because local doesn't work on tied arrays - @INC = sub { $filename = 'seen'; return undef; }; - eval { require $filename; }; - is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' ); + @INC = ('lib', 'lib/Devel', sub { $got = $_[1]; return undef; }); + foreach my $filename ('/test_require.pm', './test_require.pm', + '../test_require.pm') { + local %INC; + undef $got; + undef $test_require::loaded; + eval { require $filename; }; + is($got, $filename, "the coderef sees the pathname $filename"); + is($test_require::loaded, undef, 'no module is loaded' ); + } + + local %INC; + undef $got; + undef $test_require::loaded; + + eval { require 'test_require.pm'; }; + is($got, undef, 'the directory is scanned for test_require.pm'); + is($test_require::loaded, 1, 'the module is loaded'); @INC = @old_INC; } diff --git a/t/op/require_errors.t b/t/op/require_errors.t index bd6c750..f617e6a 100644 --- a/t/op/require_errors.t +++ b/t/op/require_errors.t @@ -7,17 +7,28 @@ BEGIN { require './test.pl'; } -plan(tests => 6); +plan(tests => 9); my $nonfile = tempfile(); @INC = qw(Perl Rules); -eval { - require $nonfile; -}; +# The tests for ' ' and '.h' never did fail, but previously the error reporting +# code would read memory before the start of the SV's buffer + +for my $file ($nonfile, ' ') { + eval { + require $file; + }; + + like $@, qr/^Can't locate $file in \@INC \(\@INC contains: @INC\) at/, + "correct error message for require '$file'"; +} -like $@, qr/^Can't locate $nonfile in \@INC \(\@INC contains: @INC\) at/; +eval "require $nonfile"; + +like $@, qr/^Can't locate $nonfile\.pm in \@INC \(\@INC contains: @INC\) at/, + "correct error message for require $nonfile"; eval { require "$nonfile.ph"; @@ -25,11 +36,14 @@ eval { like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/; -eval { - require "$nonfile.h"; -}; +for my $file ("$nonfile.h", ".h") { + eval { + require $file + }; -like $@, qr/^Can't locate $nonfile\.h in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/; + like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/, + "correct error message for require '$file'"; +} eval 'require <foom>'; like $@, qr/^<> should be quotes at /, 'require <> error'; -- Perl5 Master Repository
