diff options
author | Jesse Luehrs <doy@tozt.net> | 2012-01-06 10:28:20 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2012-01-06 10:35:56 -0600 |
commit | f37c8c6a403486522d197d9749ab3c7e7d9105ab (patch) | |
tree | d2f8f28ef36784169de8cdf5b83f476a51dd6329 | |
parent | 287563c99fd663d619916b60b24ebb60bf08591d (diff) | |
download | circular-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.pm | 26 | ||||
-rw-r--r-- | t/basic.t | 4 | ||||
-rw-r--r-- | t/dynamic.t | 78 | ||||
-rw-r--r-- | t/dynamic2.t | 12 | ||||
-rw-r--r-- | t/dynamic2/Bar.pm | 5 | ||||
-rw-r--r-- | t/dynamic2/Baz.pm | 3 | ||||
-rw-r--r-- | t/dynamic2/Foo.pm | 4 | ||||
-rw-r--r-- | t/dynamic2/Quux.pm | 3 |
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 { @@ -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; |