[perl #121196] only examine the name being included

Checking the location called from broke require overrides.

diff --git a/MANIFEST b/MANIFEST
index 400094c..9fcb518 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2903,6 +2903,7 @@ dist/base/t/base-open-chunk.t     See if base works
 dist/base/t/base-open-line.t   See if base works
 dist/base/t/base.t             See if base works
 dist/base/t/compile-time.t     See if base works
+dist/base/t/core-global.t      See if base works around CORE::GLOBAL::require
 dist/base/t/fields-5_6_0.t     See if fields work
 dist/base/t/fields-5_8_0.t     See if fields work
 dist/base/t/fields-base.t      See if fields work

diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
index d7ef70a..55d3b47 100644 (file)
--- 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 (file)
index 0000000..a912166
--- /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 $@;
+}