X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F55namespaces_cleaned.t;h=e87cab7dfc3f7df4d9f09cdff245857e073ad6a5;hb=fcf32d045;hp=b922aa5d3bac2e79902fab19d4648aab583f3212;hpb=cd1228209f685767668163c2510723959951641b;p=dbsrgits%2FDBIx-Class.git diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t index b922aa5..e87cab7 100644 --- a/t/55namespaces_cleaned.t +++ b/t/55namespaces_cleaned.t @@ -1,20 +1,32 @@ -# Pre-5.10 perls pollute %INC on unsuccesfull module -# require, making it appear as if the module is already -# loaded on subsequent require()s -# Can't seem to find the exact RT/perldelta entry BEGIN { if ($] < 5.010) { - # shut up spurious warnings without loading warnings.pm - *CORE::GLOBAL::require = sub {}; - - *CORE::GLOBAL::require = sub { - my $res = eval { CORE::require($_[0]) }; - if ($@) { - delete $INC{$_[0]}; - die + + # Pre-5.10 perls pollute %INC on unsuccesfull module + # require, making it appear as if the module is already + # loaded on subsequent require()s + # Can't seem to find the exact RT/perldelta entry + # + # The reason we can't just use a sane, clean loader, is because + # if a Module require()s another module the %INC will still + # get filled with crap and we are back to square one. A global + # fix is really the only way for this test, as we try to load + # each available module separately, and have no control (nor + # knowledge) over their common dependencies. + # + # we want to do this here, in the very beginning, before even + # warnings/strict are loaded + + unshift @INC, 't/lib'; + require DBICTest::Util::OverrideRequire; + + DBICTest::Util::OverrideRequire::override_global_require( sub { + my $res = eval { $_[0]->() }; + if ($@ ne '') { + delete $INC{$_[1]}; + die $@; } - $res; - } + return $res; + } ); } } @@ -23,6 +35,9 @@ use warnings; use Test::More; +use lib 't/lib'; +use DBICTest; + use File::Find; use File::Spec; use B qw/svref_2object/; @@ -33,7 +48,7 @@ use DBIx::Class; use DBIx::Class::Carp; my @modules = grep { - my $mod = $_; + my ($mod) = $_ =~ /(.+)/; # not all modules are loadable at all times do { @@ -94,21 +109,18 @@ for my $mod (@modules) { for my $name (keys %all_method_like) { - next if ( DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN() and $name =~ /^carp(?:_unique|_once)?$/ ); + next if ( DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN and $name =~ /^carp(?:_unique|_once)?$/ ); - # overload is a funky thing - it is neither cleaned, and its imports are named funny + # overload is a funky thing - it is not cleaned, and its imports are named funny next if $name =~ /^\(/; my $gv = svref_2object($all_method_like{$name})->GV; my $origin = $gv->STASH->NAME; - TODO: { - local $TODO = 'CAG does not clean its BEGIN constants' if $name =~ /^__CAG_/; - is ($gv->NAME, $name, "Properly named $name method at $origin" . ($origin eq $mod - ? '' - : " (inherited by $mod)" - )); - } + is ($gv->NAME, $name, "Properly named $name method at $origin" . ($origin eq $mod + ? '' + : " (inherited by $mod)" + )); next if $seen->{"${origin}:${name}"}++; @@ -135,7 +147,7 @@ for my $mod (@modules) { } } - next if DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN(); + next if DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN; # some common import names (these should never ever be methods) for my $f (qw/carp carp_once carp_unique croak confess cluck try catch finally/) { @@ -174,5 +186,4 @@ sub find_modules { return sort @modules; } - done_testing;