summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-01-06 10:28:20 -0600
committerJesse Luehrs <doy@tozt.net>2012-01-06 10:35:56 -0600
commitf37c8c6a403486522d197d9749ab3c7e7d9105ab (patch)
treed2f8f28ef36784169de8cdf5b83f476a51dd6329
parent287563c99fd663d619916b60b24ebb60bf08591d (diff)
downloadcircular-require-f37c8c6a403486522d197d9749ab3c7e7d9105ab.tar.gz
circular-require-f37c8c6a403486522d197d9749ab3c7e7d9105ab.zip
not lexical scope, but dynamic scope is close enough i think
-rw-r--r--lib/circular/require.pm26
-rw-r--r--t/basic.t4
-rw-r--r--t/dynamic.t78
-rw-r--r--t/dynamic2.t12
-rw-r--r--t/dynamic2/Bar.pm5
-rw-r--r--t/dynamic2/Baz.pm3
-rw-r--r--t/dynamic2/Foo.pm4
-rw-r--r--t/dynamic2/Quux.pm3
8 files changed, 127 insertions, 8 deletions
diff --git a/lib/circular/require.pm b/lib/circular/require.pm
index 1d9e38d..184c361 100644
--- a/lib/circular/require.pm
+++ b/lib/circular/require.pm
@@ -53,6 +53,17 @@ our $previous_file;
my $saved_require_hook;
my @hide;
+sub _find_enable_state {
+ my $depth = 0;
+ while (defined(scalar(caller(++$depth)))) {
+ my $hh = (caller($depth))[10];
+ next unless defined $hh;
+ next unless exists $hh->{'circular::require'};
+ return $hh->{'circular::require'};
+ }
+ return 0;
+}
+
sub _require {
my ($file) = @_;
# on 5.8, if a value has both a string and numeric value, require will
@@ -71,11 +82,13 @@ sub _require {
$caller = $loaded_from{$caller};
}
- if (@cycle > 1) {
- warn "Circular require detected:\n " . join("\n ", @cycle) . "\n";
- }
- else {
- warn "Circular require detected in $string_file (from unknown file)\n";
+ if (_find_enable_state()) {
+ if (@cycle > 1) {
+ warn "Circular require detected:\n " . join("\n ", @cycle) . "\n";
+ }
+ else {
+ warn "Circular require detected in $string_file (from unknown file)\n";
+ }
}
}
local $loaded_from{$string_file} = $previous_file;
@@ -108,6 +121,8 @@ sub import {
else {
$stash->remove_package_symbol('&require');
}
+ # not delete, because we want to see it being explicitly disabled
+ $^H{'circular::require'} = 0;
}
sub unimport {
@@ -123,6 +138,7 @@ sub unimport {
$saved_require_hook = $old_require
if defined($old_require) && $old_require != \&_require;
$stash->add_package_symbol('&require', \&_require);
+ $^H{'circular::require'} = 1;
}
sub _mod2pm {
diff --git a/t/basic.t b/t/basic.t
index 44fade4..d0abc8b 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -4,9 +4,7 @@ use warnings;
use lib 't/basic';
use Test::More;
-use circular::require ();
-
-circular::require->unimport;
+no circular::require;
{
my $warnings;
diff --git a/t/dynamic.t b/t/dynamic.t
new file mode 100644
index 0000000..455130a
--- /dev/null
+++ b/t/dynamic.t
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use lib 't/basic';
+
+{
+ no circular::require;
+
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+ use_ok('Foo');
+ is($warnings, "Circular require detected:\n Foo.pm\n Baz.pm\n Foo.pm\nCircular require detected:\n Baz.pm\n Bar.pm\n Baz.pm\n", "correct warnings");
+
+ clear();
+}
+
+{
+ no circular::require;
+ use circular::require;
+
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+ use_ok('Foo');
+ is($warnings, undef, "correct warnings");
+
+ clear();
+}
+
+{
+ no circular::require;
+
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+ use_ok('Foo');
+ is($warnings, "Circular require detected:\n Foo.pm\n Baz.pm\n Foo.pm\nCircular require detected:\n Baz.pm\n Bar.pm\n Baz.pm\n", "correct warnings");
+
+ clear();
+ undef $warnings;
+
+ {
+ use circular::require;
+
+ use_ok('Foo');
+ is($warnings, undef, "correct warnings");
+
+ clear();
+ undef $warnings;
+
+ {
+ no circular::require;
+
+ use_ok('Foo');
+ is($warnings, "Circular require detected:\n Foo.pm\n Baz.pm\n Foo.pm\nCircular require detected:\n Baz.pm\n Bar.pm\n Baz.pm\n", "correct warnings");
+ }
+
+ }
+}
+
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+ use_ok('Foo');
+ is($warnings, undef, "correct warnings");
+
+ clear();
+}
+
+sub clear {
+ for (qw(Foo Bar Baz)) {
+ no strict 'refs';
+ delete $::{$_};
+ delete ${$_ . '::'}{quux};
+ delete $INC{"$_.pm"};
+ }
+}
+
+done_testing;
diff --git a/t/dynamic2.t b/t/dynamic2.t
new file mode 100644
index 0000000..f1fd093
--- /dev/null
+++ b/t/dynamic2.t
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use lib 't/dynamic2';
+
+my $warnings;
+local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+use_ok('Foo');
+is($warnings, "Circular require detected:\n Bar.pm\n Baz.pm\n Bar.pm\n", "correct warnings");
+
+done_testing;
diff --git a/t/dynamic2/Bar.pm b/t/dynamic2/Bar.pm
new file mode 100644
index 0000000..ebb6a1c
--- /dev/null
+++ b/t/dynamic2/Bar.pm
@@ -0,0 +1,5 @@
+package Bar;
+use Baz;
+use circular::require;
+use Quux;
+1;
diff --git a/t/dynamic2/Baz.pm b/t/dynamic2/Baz.pm
new file mode 100644
index 0000000..c718929
--- /dev/null
+++ b/t/dynamic2/Baz.pm
@@ -0,0 +1,3 @@
+package Baz;
+use Bar;
+1;
diff --git a/t/dynamic2/Foo.pm b/t/dynamic2/Foo.pm
new file mode 100644
index 0000000..29e832a
--- /dev/null
+++ b/t/dynamic2/Foo.pm
@@ -0,0 +1,4 @@
+package Foo;
+no circular::require;
+use Bar;
+1;
diff --git a/t/dynamic2/Quux.pm b/t/dynamic2/Quux.pm
new file mode 100644
index 0000000..1dc5aba
--- /dev/null
+++ b/t/dynamic2/Quux.pm
@@ -0,0 +1,3 @@
+package Quux;
+use Bar;
+1;