summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-07-18 17:22:47 -0500
committerJesse Luehrs <doy@tozt.net>2011-07-18 17:22:47 -0500
commit5afc70702505b74c7415b954341a653a1c823cd9 (patch)
treecca53ba1b444214ded40a53841bd755b88f7baa0
parent895798d44ae7ed4837df1827677b27d26736b736 (diff)
downloadcircular-require-5afc70702505b74c7415b954341a653a1c823cd9.tar.gz
circular-require-5afc70702505b74c7415b954341a653a1c823cd9.zip
work around annoying base.pm behavior0.03
-rw-r--r--Changes1
-rw-r--r--lib/circular/require.pm17
-rw-r--r--t/03-base.t26
3 files changed, 43 insertions, 1 deletions
diff --git a/Changes b/Changes
index c3eae18..dae5ecc 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for circular-require
{{$NEXT}}
+ - work around annoying base.pm behavior (reported by wooster)
0.02 2011-01-25
- handle 'require VERSION' properly on 5.8 (ether)
diff --git a/lib/circular/require.pm b/lib/circular/require.pm
index c4d6e1f..6a8c0be 100644
--- a/lib/circular/require.pm
+++ b/lib/circular/require.pm
@@ -50,7 +50,22 @@ sub _require {
warn "Circular require detected: $string_file (from " . caller() . ")\n";
}
$seen{$string_file} = 0;
- my $ret = $saved ? $saved->($file) : CORE::require($file);
+ my $ret;
+ # XXX ugh, base.pm checks against the regex
+ # /^Can't locate .*? at \(eval / to see if it should suppress the error
+ # but we're not in an eval anymore... fake it for now, but this will
+ # definitely break if some other module that overrides CORE::require tries
+ # to do the same thing
+ if (caller eq 'base') {
+ my $mod = $file;
+ $mod =~ s+[/\\]+::+g;
+ $mod =~ s+\.pm$++;
+ $ret = $saved
+ ? $saved->($file) : eval "CORE::require($mod)";
+ }
+ else {
+ $ret = $saved ? $saved->($file) : CORE::require($file);
+ }
$seen{$string_file} = 1;
return $ret;
}
diff --git a/t/03-base.t b/t/03-base.t
new file mode 100644
index 0000000..c0e032d
--- /dev/null
+++ b/t/03-base.t
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+my $success = eval <<EOF;
+no circular::require;
+
+{
+ package Foo;
+ sub bar {}
+}
+
+{
+ package Bar;
+ use base 'Foo';
+}
+1;
+EOF
+
+my $e = $@;
+
+ok($success, "no error with use base")
+ || diag($e);
+
+done_testing;