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