summaryrefslogtreecommitdiff
path: root/dist/base
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2014-02-17 15:19:34 +1100
committerTony Cook <tony@develop-help.com>2014-02-21 14:48:44 +1100
commit257518b902b811b5f69c13080ce7e47c6ccf1611 (patch)
treea943e6bcfa0c95e408ba79128bc1057697ffde52 /dist/base
parent1cb49f85109e1712a8930f501411464826abafa6 (diff)
downloadperl-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.pm6
-rw-r--r--dist/base/t/core-global.t20
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 $@;
+}