diff options
author | Jesse Luehrs <doy@tozt.net> | 2011-07-18 17:22:47 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2011-07-18 17:22:47 -0500 |
commit | 5afc70702505b74c7415b954341a653a1c823cd9 (patch) | |
tree | cca53ba1b444214ded40a53841bd755b88f7baa0 | |
parent | 895798d44ae7ed4837df1827677b27d26736b736 (diff) | |
download | circular-require-5afc70702505b74c7415b954341a653a1c823cd9.tar.gz circular-require-5afc70702505b74c7415b954341a653a1c823cd9.zip |
work around annoying base.pm behavior0.03
-rw-r--r-- | Changes | 1 | ||||
-rw-r--r-- | lib/circular/require.pm | 17 | ||||
-rw-r--r-- | t/03-base.t | 26 |
3 files changed, 43 insertions, 1 deletions
@@ -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; |