X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F55namespaces_cleaned.t;h=24cc22b425fb2336b9a51ad45a75bf8c441679ef;hb=d3cd93b9aafcf291b29dc5d2167aab0349d5155e;hp=8a9e3373652dc0c8729582e37f72bc95f56d011f;hpb=6a0067ea3b9733538c376d0b7b47afef096c8082;p=dbsrgits%2FDBIx-Class.git diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t index 8a9e337..24cc22b 100644 --- a/t/55namespaces_cleaned.t +++ b/t/55namespaces_cleaned.t @@ -1,57 +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 -# -# we want to do this here, in the very beginning, before even -# warnings/strict are loaded BEGIN { if ($] < 5.010) { - # All of this almost verbatim copied from Lexical::SealRequireHints - # Zefram++ - - # a potential caller() in $next_require must see the correct - # immediate frame caller - my $caller = caller(0); - - our $next_require = defined(&CORE::GLOBAL::require) - ? \&CORE::GLOBAL::require - : sub { - my ($arg) = @_; - - # The shenanigans with $CORE::GLOBAL::{require} - # are required because if there's a - # &CORE::GLOBAL::require when the eval is - # executed then the CORE::require in there is - # interpreted as plain require on some Perl - # versions, leading to recursion. - my $grequire = delete $CORE::GLOBAL::{require}; - - my $result = eval sprintf ' - local $SIG{__DIE__}; - $CORE::GLOBAL::{require} = $grequire; - package %s; - CORE::require($arg); - ', $caller; - - die $@ if $@ ne ''; - return $result; - } - ; - - *CORE::GLOBAL::require = sub { - die "wrong number of arguments to require\n" - unless @_ == 1; - - my $res = eval "package $caller; \$next_require->(\@_)"; + # 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{$_[0]}; + delete $INC{$_[1]}; die $@; } - - $res; - }; + return $res; + } ); } } @@ -60,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/; @@ -101,6 +79,12 @@ my $skip_idx = { map { $_ => 1 } ( # this subclass is expected to inherit whatever crap comes # from the parent 'DBIx::Class::ResultSet::Pager', + + # this is not part of the inheritance tree (plus is a temporary fix anyway) + 'DBIx::Class::GlobalDestruction', + + # Moo does not name its generated methods, fix pending + 'DBIx::Class::Storage::BlockRunner', ) }; my $has_cmop = eval { require Class::MOP }; @@ -140,7 +124,11 @@ for my $mod (@modules) { my $origin = $gv->STASH->NAME; TODO: { - local $TODO = 'CAG does not clean its BEGIN constants' if $name =~ /^__CAG_/; + local $TODO; + if ($name =~ /^__CAG_/) { + $TODO = 'CAG does not clean its BEGIN constants'; + } + is ($gv->NAME, $name, "Properly named $name method at $origin" . ($origin eq $mod ? '' : " (inherited by $mod)" @@ -211,5 +199,4 @@ sub find_modules { return sort @modules; } - done_testing;