ext/CPANPLUS/t/40_CPANPLUS-Internals-Report.t

   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
  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;
  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;
 114                         $clone->status->prereqs({ $ModPrereq => $HighVersion });
 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     },
 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     },
 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;
 296
 297         my $prereqs = { $ModPrereq => $HighVersion };
 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     }
 307 }
 308
 309 ### callback tests
 310 {   ### as reported in bug 13086, this callback returned the wrong item
 311     ### from the list:
 312     ### $self->_callbacks->munge_test_report->($Mod, $message, $grade);
 313     my $rv = $CB->_callbacks->munge_test_report->( 1..4 );
 314     is( $rv, 2,                 "Default 'munge_test_report' callback OK" );
 315 }
 316
 317
 318 ### test creating test reports ###
 319 SKIP: {
 320         skip "You have chosen not to enable test reporting", $total_tests,
 321         unless $CB->configure_object->get_conf('cpantest');
 322
 323     skip "No report send & query modules installed", $total_tests
 324         unless $CB->_have_query_report_modules(verbose => 0);
 325
 326
 327     SKIP: {
 328         my $mod = $CB->module_tree( TEST_CONF_PREREQ ); # is released to CPAN
 329         ok( $mod,                           "Module retrieved" );
 330
 331         ### so we're not pinned down to this specific version of perl
 332         my @list = $mod->fetch_report( all_versions => 1 );
 333         skip "Possibly no net connection, or server down", 7 unless @list;
 334
 335         my $href = $list[0];
 336         ok( scalar(@list),                  "Fetched test report" );
 337         is( ref $href, ref {},              "   Return value has hashrefs" );
 338
 339         ok( $href->{grade},                 "   Has a grade" );
 340
 341         ### XXX use constants for grades?
 342         like( $href->{grade}, qr/pass|fail|unknown|na/i,
 343                                             "   Grade as expected" );
 344
 345         my $pkg_name = $mod->package_name;
 346         ok( $href->{dist},                  "   Has a dist" );
 347         like( $href->{dist}, qr/$pkg_name/, "   Dist as expected" );
 348
 349         ok( $href->{platform},              "   Has a platform" );
 350     }
 351
 352     skip "No report sending modules installed", $send_tests
 353         unless $CB->_have_send_report_modules(verbose => 0);
 354
 355     for my $type ( keys %$map ) {
 356
 357
 358         ### never enter the editor for test reports
 359         ### but check if the callback actually gets called;
 360         my $called_edit; my $called_send;
 361         $CB->_register_callback(
 362             name => 'edit_test_report',
 363             code => sub { $called_edit++; 0 }
 364         );
 365
 366         $CB->_register_callback(
 367             name => 'send_test_report',
 368             code => sub { $called_send++; 1 }
 369         );
 370
 371                 ### reset from earlier tests
 372                 $CB->_register_callback(
 373             name => 'munge_test_report',
 374             code => sub { return $_[1] }
 375         );
 376
 377         my $mod = $map->{$type}->{'pre_hook'}
 378                     ? $map->{$type}->{'pre_hook'}->( $Mod )
 379                     : $Mod;
 380
 381         my $file = do {
 382             ### so T::R does not try to resolve our maildomain, which can
 383             ### lead to large timeouts for *every* invocation in T::R < 1.51_01
 384             ### see: http://code.google.com/p/test-reporter/issues/detail?id=15
 385             local $ENV{MAILDOMAIN} ||= 'example.com';
 386             $CB->_send_report(
 387                         module        => $mod,
 388                         buffer        => $map->{$type}{'buffer'},
 389                         failed        => $map->{$type}{'failed'},
 390                         tests_skipped => ($map->{$type}{'skiptests'} ? 1 : 0),
 391                         save          => 1,
 392                     );
 393         };
 394
 395         ok( $file,              "Type '$type' written to file" );
 396         ok( -e $file,           "   File exists" );
 397
 398         my $fh = FileHandle->new($file);
 399         ok( $fh,                "   Opened file for reading" );
 400
 401         my $in = do { local $/; <$fh> };
 402         ok( $in,                "   File has contents" );
 403
 404         for my $regex ( @{$map->{$type}->{match}} ) {
 405             like( $in, $regex,  "   File contains expected contents" );
 406         }
 407
 408         ### check if our registered callback got called ###
 409         if( $map->{$type}->{check} ) {
 410             ok( $called_edit,   "   Callback to edit was called" );
 411             ok( $called_send,   "   Callback to send was called" );
 412         }
 413
 414         #unlink $file;
 415
 416
 417 ### T::R tests don't even try to mail, let's not try and be smarter
 418 ### ourselves
 419 #        {   ### use a dummy 'editor' and see if the editor
 420 #            ### invocation doesn't break things
 421 #            $conf->set_program( editor => "$^X -le1" );
 422 #            $CB->_callbacks->edit_test_report( sub { 1 } );
 423 #
 424 #            ### XXX whitebox test!!! Might change =/
 425 #            ### this makes test::reporter not ask for what editor to use
 426 #            ### XXX stupid lousy perl warnings;
 427 #            local $Test::Reporter::MacApp = 1;
 428 #            local $Test::Reporter::MacApp = 1;
 429 #
 430 #            ### now try and mail the report to a /dev/null'd mailbox
 431 #            my $ok = $CB->_send_report(
 432 #                            module  => $Mod,
 433 #                            buffer  => $map->{$type}->{'buffer'},
 434 #                            failed  => $map->{$type}->{'failed'},
 435 #                            address => NOBODY,
 436 #                        );
 437 #            ok( $ok,                "   Mailed report to NOBODY" );
 438 #       }
 439     }
 440 }
 441
 442
 443 sub missing_prereq_buffer {
 444     return q[
 445 MAKE TEST:
 446 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 .).
 447 BEGIN failed--compilation aborted.
 448     ];
 449 }
 450
 451 sub missing_tests_buffer {
 452     return q[
 453 cp lib/Acme/POE/Knee.pm blib/lib/Acme/POE/Knee.pm
 454 cp demo_race.pl blib/lib/Acme/POE/demo_race.pl
 455 cp demo_simple.pl blib/lib/Acme/POE/demo_simple.pl
 456 MAKE TEST:
 457 No tests defined for Acme::POE::Knee extension.
 458     ];
 459 }
 460
 461 sub perl_version_too_low_buffer_mm {
 462     return q[
 463 Running [/usr/bin/perl5.8.1 Makefile.PL ]...
 464 Perl v5.8.3 required--this is only v5.8.1, stopped at Makefile.PL line 1.
 465 BEGIN failed--compilation aborted at Makefile.PL line 1.
 466 [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.
 467 BEGIN failed--compilation aborted at Makefile.PL line 1.
 468  -- cannot continue
 469     ];
 470 }
 471
 472 sub perl_version_too_low_buffer_build {
 473     my $type = shift;
 474     return q[
 475 ERROR: perl: Version 5.006001 is installed, but we need version >= 5.008001
 476 ERROR: version: Prerequisite version isn't installed
 477 ERRORS/WARNINGS FOUND IN PREREQUISITES.  You may wish to install the versions
 478  of the modules indicated above before proceeding with this installation.
 479     ]   if($type == 1);
 480     return q[
 481 ERROR: Version 5.006001 of perl is installed, but we need version >= 5.008001
 482 ERROR: version: Prerequisite version isn't installed
 483 ERRORS/WARNINGS FOUND IN PREREQUISITES.  You may wish to install the versions
 484  of the modules indicated above before proceeding with this installation.
 485     ]   if($type == 2);
 486 }
 487
 488 # Local variables:
 489 # c-indentation-style: bsd
 490 # c-basic-offset: 4
 491 # indent-tabs-mode: nil
 492 # End:
 493 # vim: expandtab shiftwidth=4: