Commit | Line | Data |
6aaee015 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | use strict; |
8 | use CPANPLUS::Backend; |
9 | use CPANPLUS::Internals::Constants::Report; |
10 | |
11 | my $send_tests = 55; |
12 | my $query_tests = 8; |
13 | my $total_tests = $send_tests + $query_tests; |
14 | |
15 | use Test::More 'no_plan'; |
16 | use Module::Load::Conditional qw[can_load]; |
17 | |
18 | use FileHandle; |
19 | use Data::Dumper; |
20 | |
21 | use constant NOBODY => 'nobody@xs4all.nl'; |
22 | |
23 | my $conf = gimme_conf(); |
24 | my $CB = CPANPLUS::Backend->new( $conf ); |
25 | my $ModName = TEST_CONF_MODULE; |
26 | my $ModPrereq = TEST_CONF_PREREQ; |
27 | my $Mod = $CB->module_tree($ModName); |
28 | my $int_ver = $CPANPLUS::Internals::VERSION; |
29 | |
30 | ### explicitly enable testing if possible ### |
31 | $CB->configure_object->set_conf(cpantest =>1) if $ARGV[0]; |
32 | |
33 | my $map = { |
34 | all_ok => { |
35 | buffer => '', # output from build process |
36 | failed => 0, # indicate failure |
37 | match => [qw|/PASS/|], # list of regexes for the output |
38 | check => 0, # check if callbacks got called? |
39 | }, |
40 | skipped_test => { |
41 | buffer => '', |
42 | failed => 0, |
43 | match => ['/PASS/', |
44 | '/tests for this module were skipped during this build/', |
45 | ], |
46 | check => 0, |
47 | skiptests |
48 | => 1, # did we skip the tests? |
49 | }, |
50 | missing_prereq => { |
51 | buffer => missing_prereq_buffer(), |
52 | failed => 1, |
53 | match => ['/The comments above are created mechanically/', |
54 | '/computer-generated error report/', |
55 | '/Below is the error stack from stage/', |
56 | '/test suite seem to fail without these modules/', |
57 | '/floo/', |
58 | '/FAIL/', |
59 | '/make test/', |
60 | ], |
61 | check => 1, |
62 | }, |
63 | missing_tests => { |
64 | buffer => missing_tests_buffer(), |
65 | failed => 1, |
66 | match => ['/The comments above are created mechanically/', |
67 | '/computer-generated error report/', |
68 | '/Below is the error stack from stage/', |
69 | '/RECOMMENDATIONS/', |
70 | '/UNKNOWN/', |
71 | '/make test/', |
72 | ], |
73 | check => 0, |
74 | }, |
75 | perl_version_too_low_mm => { |
76 | buffer => perl_version_too_low_buffer_mm(), |
77 | failed => 1, |
78 | match => ['/This distribution has been tested/', |
79 | '/http://testers.cpan.org/', |
80 | '/NA/', |
81 | ], |
82 | check => 0, |
83 | }, |
84 | perl_version_too_low_build1 => { |
85 | buffer => perl_version_too_low_buffer_build(1), |
86 | failed => 1, |
87 | match => ['/This distribution has been tested/', |
88 | '/http://testers.cpan.org/', |
89 | '/NA/', |
90 | ], |
91 | check => 0, |
92 | }, |
93 | perl_version_too_low_build2 => { |
94 | buffer => perl_version_too_low_buffer_build(2), |
95 | failed => 1, |
96 | match => ['/This distribution has been tested/', |
97 | '/http://testers.cpan.org/', |
98 | '/NA/', |
99 | ], |
100 | check => 0, |
101 | }, |
102 | prereq_versions_too_low => { |
103 | ### set the prereq version incredibly high |
104 | pre_hook => sub { |
105 | my $mod = shift; |
106 | my $clone = $mod->clone; |
5bc5f6dc |
107 | $clone->status->prereqs( { $ModPrereq => ~0 } ); |
6aaee015 |
108 | return $clone; |
109 | }, |
110 | failed => 1, |
111 | match => ['/This distribution has been tested/', |
112 | '/http://testers.cpan.org/', |
113 | '/NA/', |
114 | ], |
115 | check => 0, |
116 | }, |
117 | prereq_not_on_cpan => { |
118 | pre_hook => sub { |
119 | my $mod = shift; |
120 | my $clone = $mod->clone; |
121 | $clone->status->prereqs( |
122 | { TEST_CONF_INVALID_MODULE, 0 } |
123 | ); |
124 | return $clone; |
125 | }, |
126 | failed => 1, |
127 | match => ['/This distribution has been tested/', |
128 | '/http://testers.cpan.org/', |
129 | '/NA/', |
130 | ], |
131 | check => 0, |
132 | }, |
133 | |
134 | |
135 | |
136 | }; |
137 | |
138 | ### test config settings |
139 | { for my $opt ( qw[cpantest cpantest_mx] ) { |
140 | my $warnings; |
141 | local $SIG{__WARN__} = sub { $warnings .= "@_" }; |
142 | |
143 | my $org = $conf->get_conf( $opt ); |
144 | ok( $conf->set_conf( $opt => $$ ), |
145 | "Setting option $opt to $$" ); |
146 | is( $conf->get_conf( $opt ), $$, |
147 | " Retrieved properly" ); |
148 | ok( $conf->set_conf( $opt => $org ), |
149 | " Option $opt set back to original" ); |
150 | ok( !$warnings, " No warnings" ); |
151 | } |
152 | } |
153 | |
154 | ### test constants ### |
155 | { { my $to = CPAN_MAIL_ACCOUNT->('foo'); |
156 | is( $to, 'foo@cpan.org', "Got proper mail account" ); |
157 | } |
158 | |
159 | { ok(RELEVANT_TEST_RESULT->($Mod),"Test is relevant" ); |
160 | |
161 | ### test non-relevant tests ### |
162 | my $cp = $Mod->clone; |
163 | $cp->module( $Mod->module . '::' . ($^O eq 'beos' ? 'MSDOS' : 'Be') ); |
164 | ok(!RELEVANT_TEST_RESULT->($cp),"Test is irrelevant"); |
165 | } |
166 | |
167 | { my $support = "it works!"; |
168 | my @support = ( "No support for OS", |
169 | "OS unsupported", |
170 | "os unsupported", |
171 | ); |
172 | ok(!UNSUPPORTED_OS->($support), "OS supported"); |
173 | ok( UNSUPPORTED_OS->($_), "OS not supported") for(@support); |
174 | } |
175 | |
176 | { ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_mm() ), |
177 | "Perl version too low" ); |
178 | ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_build(1) ), |
179 | "Perl version too low" ); |
180 | ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_build(2) ), |
181 | "Perl version too low" ); |
182 | ok(!PERL_VERSION_TOO_LOW->('foo'), |
183 | " Perl version adequate" ); |
184 | } |
185 | |
186 | { my $tests = "test.pl"; |
187 | my @none = ( "No tests defined for Foo extension.", |
188 | "'No tests defined for Foo::Bar extension.'", |
189 | "'No tests defined.'", |
190 | ); |
191 | ok(!NO_TESTS_DEFINED->($tests), "Tests defined"); |
192 | ok( NO_TESTS_DEFINED->($_), "No tests defined") for(@none); |
193 | } |
194 | |
195 | { my $fail = 'MAKE TEST'; my $unknown = 'foo'; |
196 | is( TEST_FAIL_STAGE->($fail), lc $fail, |
197 | "Proper test fail stage found" ); |
198 | is( TEST_FAIL_STAGE->($unknown), 'fetch', |
199 | "Proper test fail stage found" ); |
200 | } |
201 | |
202 | ### test missing prereqs |
203 | { my $str = q[Can't locate Foo/Bar.pm in @INC]; |
204 | |
205 | ### standard test |
206 | { my @list = MISSING_PREREQS_LIST->( $str ); |
207 | is( scalar(@list), 1, " List of missing prereqs found" ); |
208 | is( $list[0], 'Foo::Bar', " Proper prereq found" ); |
209 | } |
210 | |
211 | ### multiple mentions of same prereq |
212 | { my @list = MISSING_PREREQS_LIST->( $str . $str ); |
213 | |
214 | is( scalar(@list), 1, " 1 result for multiple mentions" ); |
215 | is( $list[0], 'Foo::Bar', " Proper prereq found" ); |
216 | } |
217 | } |
218 | |
219 | { # cp version, author |
220 | my $header = REPORT_MESSAGE_HEADER->($int_ver,'foo'); |
221 | ok( $header, "Test header generated" ); |
222 | like( $header, qr/Dear foo,/, " Proper content found" ); |
223 | like( $header, qr/puter-gen/, " Proper content found" ); |
224 | like( $header, qr/CPANPLUS,/, " Proper content found" ); |
225 | like( $header, qr/ments may/, " Proper content found" ); |
226 | } |
227 | |
228 | { # stage, buffer |
229 | my $header = REPORT_MESSAGE_FAIL_HEADER->('test','buffer'); |
230 | ok( $header, "Test header generated" ); |
231 | like( $header, qr/uploading/, " Proper content found" ); |
232 | like( $header, qr/RESULTS:/, " Proper content found" ); |
233 | like( $header, qr/stack/, " Proper content found" ); |
234 | like( $header, qr/buffer/, " Proper content found" ); |
235 | } |
236 | |
237 | { my $prereqs = REPORT_MISSING_PREREQS->('foo','bar@example.com','Foo::Bar'); |
238 | ok( $prereqs, "Test output generated" ); |
239 | like( $prereqs, qr/'foo \(bar\@example\.com\)'/, |
240 | " Proper content found" ); |
241 | like( $prereqs, qr/Foo::Bar/, " Proper content found" ); |
242 | like( $prereqs, qr/prerequisi/, " Proper content found" ); |
243 | like( $prereqs, qr/PREREQ_PM/, " Proper content found" ); |
244 | } |
245 | |
246 | { my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar'); |
247 | ok( $prereqs, "Test output generated" ); |
248 | like( $prereqs, qr/Your Name/, " Proper content found" ); |
249 | like( $prereqs, qr/Foo::Bar/, " Proper content found" ); |
250 | like( $prereqs, qr/prerequisi/, " Proper content found" ); |
251 | like( $prereqs, qr/PREREQ_PM/, " Proper content found" ); |
252 | } |
253 | |
254 | { my $missing = REPORT_MISSING_TESTS->(); |
255 | ok( $missing, "Missing test string generated" ); |
256 | like( $missing, qr/tests/, " Proper content found" ); |
257 | like( $missing, qr/Test::More/, " Proper content found" ); |
258 | } |
259 | |
260 | { my $missing = REPORT_MESSAGE_FOOTER->(); |
261 | ok( $missing, "Message footer string generated" ); |
262 | like( $missing, qr/NOTE/, " Proper content found" ); |
263 | like( $missing, qr/identical/, " Proper content found" ); |
264 | like( $missing, qr/mistaken/, " Proper content found" ); |
265 | like( $missing, qr/appreciate/, " Proper content found" ); |
266 | like( $missing, qr/Additional/, " Proper content found" ); |
267 | } |
268 | |
269 | { my @libs = MISSING_EXTLIBS_LIST->("No library found for -lfoo\nNo library found for -lbar"); |
270 | ok( @libs, "Missing external libraries found" ); |
271 | my @list = qw(foo bar); |
272 | is_deeply( \@libs, \@list, " Proper content found" ); |
273 | } |
274 | |
275 | { my $clone = $Mod->clone; |
5bc5f6dc |
276 | |
277 | ### divide by two -- possibly ~0 is unsigned, and we cause an overflow, |
278 | ### as happens to version.pm 0.7203 among others. |
48e1361c |
279 | my $prereqs = { $ModPrereq => ~0/2 }; |
6aaee015 |
280 | |
281 | $clone->status->prereqs( $prereqs ); |
282 | |
283 | my $str = REPORT_LOADED_PREREQS->( $clone ); |
284 | |
285 | like($str, qr/PREREQUISITES:/, "Listed loaded prerequisites" ); |
286 | like($str, qr/\! $ModPrereq\s+\S+\s+\S+/, |
287 | " Proper content found" ); |
288 | } |
289 | } |
290 | |
291 | ### callback tests |
292 | { ### as reported in bug 13086, this callback returned the wrong item |
293 | ### from the list: |
294 | ### $self->_callbacks->munge_test_report->($Mod, $message, $grade); |
295 | my $rv = $CB->_callbacks->munge_test_report->( 1..4 ); |
296 | is( $rv, 2, "Default 'munge_test_report' callback OK" ); |
297 | } |
298 | |
299 | |
300 | ### test creating test reports ### |
301 | SKIP: { |
302 | skip "You have chosen not to enable test reporting", $total_tests, |
303 | unless $CB->configure_object->get_conf('cpantest'); |
304 | |
305 | skip "No report send & query modules installed", $total_tests |
306 | unless $CB->_have_query_report_modules(verbose => 0); |
307 | |
308 | |
309 | SKIP: { |
310 | my $mod = $CB->module_tree( TEST_CONF_PREREQ ); # is released to CPAN |
311 | ok( $mod, "Module retrieved" ); |
312 | |
313 | ### so we're not pinned down to this specific version of perl |
314 | my @list = $mod->fetch_report( all_versions => 1 ); |
315 | skip "Possibly no net connection, or server down", 7 unless @list; |
316 | |
317 | my $href = $list[0]; |
318 | ok( scalar(@list), "Fetched test report" ); |
319 | is( ref $href, ref {}, " Return value has hashrefs" ); |
320 | |
321 | ok( $href->{grade}, " Has a grade" ); |
322 | |
323 | ### XXX use constants for grades? |
324 | like( $href->{grade}, qr/pass|fail|unknown|na/i, |
325 | " Grade as expected" ); |
326 | |
327 | my $pkg_name = $mod->package_name; |
328 | ok( $href->{dist}, " Has a dist" ); |
329 | like( $href->{dist}, qr/$pkg_name/, " Dist as expected" ); |
330 | |
331 | ok( $href->{platform}, " Has a platform" ); |
332 | } |
333 | |
334 | skip "No report sending modules installed", $send_tests |
335 | unless $CB->_have_send_report_modules(verbose => 0); |
336 | |
337 | for my $type ( keys %$map ) { |
338 | |
339 | |
340 | ### never enter the editor for test reports |
341 | ### but check if the callback actually gets called; |
342 | my $called_edit; my $called_send; |
343 | $CB->_register_callback( |
344 | name => 'edit_test_report', |
345 | code => sub { $called_edit++; 0 } |
346 | ); |
347 | |
348 | $CB->_register_callback( |
349 | name => 'send_test_report', |
350 | code => sub { $called_send++; 1 } |
351 | ); |
352 | |
353 | ### reset from earlier tests |
354 | $CB->_register_callback( |
355 | name => 'munge_test_report', |
356 | code => sub { return $_[1] } |
357 | ); |
358 | |
359 | my $mod = $map->{$type}->{'pre_hook'} |
360 | ? $map->{$type}->{'pre_hook'}->( $Mod ) |
361 | : $Mod; |
362 | |
363 | my $file = $CB->_send_report( |
364 | module => $mod, |
365 | buffer => $map->{$type}{'buffer'}, |
366 | failed => $map->{$type}{'failed'}, |
367 | tests_skipped => ($map->{$type}{'skiptests'} ? 1 : 0), |
368 | save => 1, |
369 | dontcc => 1, # no need to send, and also skips |
370 | # fetching reports from testers.cpan |
371 | ); |
372 | |
373 | ok( $file, "Type '$type' written to file" ); |
374 | ok( -e $file, " File exists" ); |
375 | |
376 | my $fh = FileHandle->new($file); |
377 | ok( $fh, " Opened file for reading" ); |
378 | |
379 | my $in = do { local $/; <$fh> }; |
380 | ok( $in, " File has contents" ); |
381 | |
382 | for my $regex ( @{$map->{$type}->{match}} ) { |
383 | like( $in, $regex, " File contains expected contents" ); |
384 | } |
385 | |
386 | ### check if our registered callback got called ### |
387 | if( $map->{$type}->{check} ) { |
388 | ok( $called_edit, " Callback to edit was called" ); |
389 | ok( $called_send, " Callback to send was called" ); |
390 | } |
391 | |
392 | #unlink $file; |
393 | |
394 | |
395 | ### T::R tests don't even try to mail, let's not try and be smarter |
396 | ### ourselves |
397 | # { ### use a dummy 'editor' and see if the editor |
398 | # ### invocation doesn't break things |
399 | # $conf->set_program( editor => "$^X -le1" ); |
400 | # $CB->_callbacks->edit_test_report( sub { 1 } ); |
401 | # |
402 | # ### XXX whitebox test!!! Might change =/ |
403 | # ### this makes test::reporter not ask for what editor to use |
404 | # ### XXX stupid lousy perl warnings; |
405 | # local $Test::Reporter::MacApp = 1; |
406 | # local $Test::Reporter::MacApp = 1; |
407 | # |
408 | # ### now try and mail the report to a /dev/null'd mailbox |
409 | # my $ok = $CB->_send_report( |
410 | # module => $Mod, |
411 | # buffer => $map->{$type}->{'buffer'}, |
412 | # failed => $map->{$type}->{'failed'}, |
413 | # address => NOBODY, |
414 | # dontcc => 1, |
415 | # ); |
416 | # ok( $ok, " Mailed report to NOBODY" ); |
417 | # } |
418 | } |
419 | } |
420 | |
421 | |
422 | sub missing_prereq_buffer { |
423 | return q[ |
424 | MAKE TEST: |
425 | Can't locate floo.pm in @INC (@INC contains: /Users/kane/sources/p4/other/archive-extract/lib /Users/kane/sources/p4/other/file-fetch/lib /Users/kane/sources/p4/other/archive-tar-new/lib /Users/kane/sources/p4/other/carp-trace/lib /Users/kane/sources/p4/other/log-message/lib /Users/kane/sources/p4/other/module-load/lib /Users/kane/sources/p4/other/params-check/lib /Users/kane/sources/p4/other/qmail-checkpassword/lib /Users/kane/sources/p4/other/module-load-conditional/lib /Users/kane/sources/p4/other/term-ui/lib /Users/kane/sources/p4/other/ipc-cmd/lib /Users/kane/sources/p4/other/config-auto/lib /Users/kane/sources/NSA /Users/kane/sources/NSA/misc /Users/kane/sources/NSA/test /Users/kane/sources/beheer/perl /opt/lib/perl5/5.8.3/darwin-2level /opt/lib/perl5/5.8.3 /opt/lib/perl5/site_perl/5.8.3/darwin-2level /opt/lib/perl5/site_perl/5.8.3 /opt/lib/perl5/site_perl .). |
426 | BEGIN failed--compilation aborted. |
427 | ]; |
428 | } |
429 | |
430 | sub missing_tests_buffer { |
431 | return q[ |
432 | cp lib/Acme/POE/Knee.pm blib/lib/Acme/POE/Knee.pm |
433 | cp demo_race.pl blib/lib/Acme/POE/demo_race.pl |
434 | cp demo_simple.pl blib/lib/Acme/POE/demo_simple.pl |
435 | MAKE TEST: |
436 | No tests defined for Acme::POE::Knee extension. |
437 | ]; |
438 | } |
439 | |
440 | sub perl_version_too_low_buffer_mm { |
441 | return q[ |
442 | Running [/usr/bin/perl5.8.1 Makefile.PL ]... |
443 | Perl v5.8.3 required--this is only v5.8.1, stopped at Makefile.PL line 1. |
444 | BEGIN failed--compilation aborted at Makefile.PL line 1. |
445 | [ERROR] Could not run '/usr/bin/perl5.8.1 Makefile.PL': Perl v5.8.3 required--this is only v5.8.1, stopped at Makefile.PL line 1. |
446 | BEGIN failed--compilation aborted at Makefile.PL line 1. |
447 | -- cannot continue |
448 | ]; |
449 | } |
450 | |
451 | sub perl_version_too_low_buffer_build { |
452 | my $type = shift; |
453 | return q[ |
454 | ERROR: perl: Version 5.006001 is installed, but we need version >= 5.008001 |
455 | ERROR: version: Prerequisite version isn't installed |
456 | ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions |
457 | of the modules indicated above before proceeding with this installation. |
458 | ] if($type == 1); |
459 | return q[ |
460 | ERROR: Version 5.006001 of perl is installed, but we need version >= 5.008001 |
461 | ERROR: version: Prerequisite version isn't installed |
462 | ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions |
463 | of the modules indicated above before proceeding with this installation. |
464 | ] if($type == 2); |
465 | } |
466 | |
467 | # Local variables: |
468 | # c-indentation-style: bsd |
469 | # c-basic-offset: 4 |
470 | # indent-tabs-mode: nil |
471 | # End: |
472 | # vim: expandtab shiftwidth=4: |