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