Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
88b1530a |
3 | BEGIN { |
750a4ad2 |
4 | if ( "$]" < 5.010) { |
6a0067ea |
5 | |
45638aed |
6 | # Pre-5.10 perls pollute %INC on unsuccesfull module |
7 | # require, making it appear as if the module is already |
8 | # loaded on subsequent require()s |
9 | # Can't seem to find the exact RT/perldelta entry |
10 | # |
11 | # The reason we can't just use a sane, clean loader, is because |
12 | # if a Module require()s another module the %INC will still |
13 | # get filled with crap and we are back to square one. A global |
14 | # fix is really the only way for this test, as we try to load |
15 | # each available module separately, and have no control (nor |
16 | # knowledge) over their common dependencies. |
17 | # |
18 | # we want to do this here, in the very beginning, before even |
19 | # warnings/strict are loaded |
20 | |
c0329273 |
21 | |
45638aed |
22 | require DBICTest::Util::OverrideRequire; |
23 | |
24 | DBICTest::Util::OverrideRequire::override_global_require( sub { |
25 | my $res = eval { $_[0]->() }; |
6a0067ea |
26 | if ($@ ne '') { |
45638aed |
27 | delete $INC{$_[1]}; |
6a0067ea |
28 | die $@; |
88b1530a |
29 | } |
45638aed |
30 | return $res; |
31 | } ); |
88b1530a |
32 | } |
33 | } |
34 | |
9c1700e3 |
35 | use strict; |
36 | use warnings; |
37 | |
38 | use Test::More; |
39 | |
70cf159f |
40 | use DBICTest; |
9c1700e3 |
41 | use File::Find; |
42 | use File::Spec; |
b090048f |
43 | use DBIx::Class::_Util qw( get_subname describe_class_methods ); |
9c1700e3 |
44 | |
45 | # makes sure we can load at least something |
46 | use DBIx::Class; |
90cfe42b |
47 | use DBIx::Class::Carp; |
9c1700e3 |
48 | |
b090048f |
49 | my @modules = map { |
50 | # FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME |
51 | # FIXME !!! without this detaint I get the test into an infloop on 5.16.x |
52 | # (maybe other versions): https://travis-ci.org/ribasushi/dbix-class/jobs/144738784#L26762 |
53 | # |
54 | # or locally like: |
55 | # |
56 | # ~$ ulimit -v $(( 1024 * 256 )); perl -d:Confess -Ilib -Tl xt/extra/internals/namespaces_cleaned.t |
57 | # ... |
58 | # DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166 |
59 | # DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166 |
60 | # DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166 |
61 | # DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 154 |
62 | # DBIx::Class::MethodAttributes::FETCH_CODE_ATTRIBUTES("DBIx::Class::Storage::DBI::ODBC::Firebird", CODE(0x42ac2b0)) called at /home/rabbit/perl5/perlbrew/perls/5.16.2/lib/5.16.2/x86_64-linux-thread-multi-ld/attributes.pm line 101 |
63 | # attributes::get(CODE(0x42ac2b0)) called at lib/DBIx/Class/_Util.pm line 885 |
64 | # eval {...} called at lib/DBIx/Class/_Util.pm line 885 |
65 | # DBIx::Class::_Util::describe_class_methods("DBIx::Class::Storage::DBI::ODBC::Firebird") called at xt/extra/internals/namespaces_cleaned.t line 129 |
66 | # Out of memory! |
67 | # Out of memory! |
68 | # Out of memory! |
69 | # ... |
70 | # Segmentation fault |
71 | # |
72 | # FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME |
73 | # Sweeping it under the rug for now as this is an xt/ test, |
74 | # but someone *must* find what is going on eventually |
75 | # FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME |
76 | |
77 | ( $_ =~ /(.+)/ ) |
78 | |
79 | } grep { |
f3ec358e |
80 | my ($mod) = $_ =~ /(.+)/; |
9c1700e3 |
81 | |
9c1700e3 |
82 | # not all modules are loadable at all times |
88b1530a |
83 | do { |
84 | # trap deprecation warnings and whatnot |
85 | local $SIG{__WARN__} = sub {}; |
86 | eval "require $mod"; |
87 | } ? $mod : do { |
88 | SKIP: { skip "Failed require of $mod: " . ($@ =~ /^(.+?)$/m)[0], 1 }; |
89 | (); # empty RV for @modules |
9c1700e3 |
90 | }; |
91 | |
9c1700e3 |
92 | } find_modules(); |
93 | |
94 | # have an exception table for old and/or weird code we are not sure |
95 | # we *want* to clean in the first place |
96 | my $skip_idx = { map { $_ => 1 } ( |
51ec0382 |
97 | 'SQL::Translator::Producer::DBIx::Class::File', # too crufty to touch |
9c1700e3 |
98 | |
99 | # not sure how to handle type libraries |
100 | 'DBIx::Class::Storage::DBI::Replicated::Types', |
101 | 'DBIx::Class::Admin::Types', |
102 | |
103 | # G::L::D is unclean, but we never inherit from it |
104 | 'DBIx::Class::Admin::Descriptive', |
105 | 'DBIx::Class::Admin::Usage', |
cd122820 |
106 | |
107 | # this subclass is expected to inherit whatever crap comes |
108 | # from the parent |
109 | 'DBIx::Class::ResultSet::Pager', |
9f98c4b2 |
110 | |
b1dbf716 |
111 | # utility classes, not part of the inheritance chain |
3f5e367a |
112 | 'DBIx::Class::Optional::Dependencies', |
9f98c4b2 |
113 | 'DBIx::Class::ResultSource::RowParser::Util', |
b1dbf716 |
114 | 'DBIx::Class::_Util', |
9c1700e3 |
115 | ) }; |
116 | |
bfcecabc |
117 | my $has_moose = eval { require Moose::Util }; |
9c1700e3 |
118 | |
9c1700e3 |
119 | my $seen; #inheritance means we will see the same method multiple times |
120 | |
121 | for my $mod (@modules) { |
122 | SKIP: { |
123 | skip "$mod exempt from namespace checks",1 if $skip_idx->{$mod}; |
124 | |
b090048f |
125 | my %all_method_like = |
126 | map |
127 | { $_->[0]{name} => $mod->can( $_->[0]{name} ) } |
128 | grep |
129 | { $_->[0]{via_class} ne 'UNIVERSAL' } |
130 | values %{ describe_class_methods($mod)->{methods} } |
131 | ; |
9c1700e3 |
132 | |
133 | my %parents = map { $_ => 1 } @{mro::get_linear_isa($mod)}; |
134 | |
135 | my %roles; |
bfcecabc |
136 | if ($has_moose and my $mc = Moose::Util::find_meta($mod)) { |
9c1700e3 |
137 | if ($mc->can('calculate_all_roles_with_inheritance')) { |
138 | $roles{$_->name} = 1 for ($mc->calculate_all_roles_with_inheritance); |
139 | } |
140 | } |
141 | |
142 | for my $name (keys %all_method_like) { |
143 | |
6a0067ea |
144 | # overload is a funky thing - it is not cleaned, and its imports are named funny |
9c1700e3 |
145 | next if $name =~ /^\(/; |
146 | |
86a432d4 |
147 | my ($origin, $cv_name) = get_subname($all_method_like{$name}); |
9c1700e3 |
148 | |
86a432d4 |
149 | is ($cv_name, $name, "Properly named $name method at $origin" . ($origin eq $mod |
8b4d8064 |
150 | ? '' |
151 | : " (inherited by $mod)" |
152 | )); |
9c1700e3 |
153 | |
86a432d4 |
154 | next if $seen->{"${origin}::${name}"}++; |
70c28808 |
155 | |
9c1700e3 |
156 | if ($origin eq $mod) { |
157 | pass ("$name is a native $mod method"); |
158 | } |
159 | elsif ($roles{$origin}) { |
160 | pass ("${mod}::${name} came from consumption of role $origin"); |
161 | } |
162 | elsif ($parents{$origin}) { |
163 | pass ("${mod}::${name} came from proper parent-class $origin"); |
164 | } |
165 | else { |
166 | my $via; |
167 | for (reverse @{mro::get_linear_isa($mod)} ) { |
168 | if ( ($_->can($name)||'') eq $all_method_like{$name} ) { |
169 | $via = $_; |
170 | last; |
171 | } |
172 | } |
b5ce6748 |
173 | |
174 | # exception time |
175 | if ( |
176 | ( $name eq 'import' and $via = 'Exporter' ) |
51ec0382 |
177 | or |
178 | # jesus christ nobody had any idea how to design an interface back then |
179 | ( $name =~ /_trigger/ and $via = 'Class::Trigger' ) |
b5ce6748 |
180 | ) { |
181 | pass("${mod}::${name} is a valid uncleaned import from ${name}"); |
182 | } |
183 | else { |
184 | fail ("${mod}::${name} appears to have entered inheritance chain by import into " |
185 | . ($via || 'UNKNOWN') |
186 | ); |
187 | } |
9c1700e3 |
188 | } |
189 | } |
70c28808 |
190 | |
191 | # some common import names (these should never ever be methods) |
192 | for my $f (qw/carp carp_once carp_unique croak confess cluck try catch finally/) { |
193 | if ($mod->can($f)) { |
194 | my $via; |
195 | for (reverse @{mro::get_linear_isa($mod)} ) { |
196 | if ( ($_->can($f)||'') eq $all_method_like{$f} ) { |
197 | $via = $_; |
198 | last; |
199 | } |
200 | } |
201 | fail ("Import $f leaked into method list of ${mod}, appears to have entered inheritance chain at " |
202 | . ($via || 'UNKNOWN') |
203 | ); |
204 | } |
205 | else { |
206 | pass ("Import $f not leaked into method list of $mod"); |
207 | } |
208 | } |
9c1700e3 |
209 | } |
210 | } |
211 | |
212 | sub find_modules { |
213 | my @modules; |
214 | |
35f4cebe |
215 | find( { |
9c1700e3 |
216 | wanted => sub { |
217 | -f $_ or return; |
399b9455 |
218 | $_ =~ m|lib/DBIx/Class/_TempExtlib| and return; |
9c1700e3 |
219 | s/\.pm$// or return; |
220 | s/^ (?: lib | blib . (?:lib|arch) ) . //x; |
221 | push @modules, join ('::', File::Spec->splitdir($_)); |
222 | }, |
223 | no_chdir => 1, |
35f4cebe |
224 | }, ( |
225 | # find them in both lib and blib, duplicates are fine, since |
226 | # @INC is preadjusted for us by the harness |
227 | 'lib', |
228 | ( -e 'blib' ? 'blib' : () ), |
229 | )); |
9c1700e3 |
230 | |
231 | return sort @modules; |
232 | } |
233 | |
9c1700e3 |
234 | done_testing; |