diff options
author | Tony Cook <tony@develop-help.com> | 2014-02-17 15:19:34 +1100 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2014-02-21 14:48:44 +1100 |
commit | 257518b902b811b5f69c13080ce7e47c6ccf1611 (patch) | |
tree | a943e6bcfa0c95e408ba79128bc1057697ffde52 /dist/base | |
parent | 1cb49f85109e1712a8930f501411464826abafa6 (diff) | |
download | perl-257518b902b811b5f69c13080ce7e47c6ccf1611.tar.gz |
[perl #121196] only examine the name being included
Checking the location called from broke require overrides.
Diffstat (limited to 'dist/base')
-rw-r--r-- | dist/base/lib/base.pm | 6 | ||||
-rw-r--r-- | dist/base/t/core-global.t | 20 |
2 files changed, 22 insertions, 4 deletions
diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm index d7ef70af0f..55d3b47d29 100644 --- a/dist/base/lib/base.pm +++ b/dist/base/lib/base.pm @@ -96,8 +96,6 @@ sub import { { local $SIG{__DIE__}; my $fn = _module_to_filename($base); - my $file = __FILE__; - my $line = __LINE__ + 1; eval { require $fn }; # Only ignore "Can't locate" errors from our eval require. # Other fatal errors (syntax etc) must be reported. @@ -107,8 +105,8 @@ sub import { # probably be using parent.pm, which doesn't try to # guess whether require is needed or failed, # see [perl #118561] - die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at \Q$file\E line \Q$line\E(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s - || $@ =~ /Compilation failed in require at \Q$file\E line \Q$line\E(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/; + die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s + || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/; unless (%{"$base\::"}) { require Carp; local $" = " "; diff --git a/dist/base/t/core-global.t b/dist/base/t/core-global.t new file mode 100644 index 0000000000..a912166ea5 --- /dev/null +++ b/dist/base/t/core-global.t @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 1; + +BEGIN { *CORE::GLOBAL::require = sub { require $_[0] }; } + +{ + # [perl #121196] + { + package RequireOverride; + sub zzz {} + } + ok(eval <<'EOS', "handle require overrides") +package RequireOverrideB; +use base 'RequireOverride'; +1 +EOS + or diag $@; +} |