[p5sagit/p5-mst-13.2.git] / cpan / CPANPLUS / t / 40_CPANPLUS-Internals-Report.t

### make sure we can find our conf.pl file
BEGIN { 
    use FindBin; 
    require "$FindBin::Bin/inc/conf.pl";
}

use strict;
use CPANPLUS::Backend;
use CPANPLUS::Internals::Constants::Report;

my $send_tests  = 55;
my $query_tests = 8;
my $total_tests = $send_tests + $query_tests;

use Test::More                  'no_plan';
use Module::Load::Conditional   qw[can_load];

use FileHandle;
use Data::Dumper;

use constant NOBODY => 'nobody@xs4all.nl';

my $conf        = gimme_conf();
my $CB          = CPANPLUS::Backend->new( $conf );
my $ModName     = TEST_CONF_MODULE;
my $ModPrereq   = TEST_CONF_PREREQ;

### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause 
### an overflow, as happens to version.pm 0.7203 among others.
### ANOTHER bug in version.pm, this time for 64bit:
### https://rt.cpan.org/Ticket/Display.html?id=45241
### so just use a 'big number'(tm) and go from there.
my $HighVersion = 1234567890;
my $Mod         = $CB->module_tree($ModName);
my $int_ver     = $CPANPLUS::Internals::VERSION;

### explicitly enable testing if possible ###
$CB->configure_object->set_conf(cpantest =>1) if $ARGV[0];

my $map = {
    all_ok  => {
        buffer  => '',              # output from build process
        failed  => 0,               # indicate failure
        match   => [qw|/PASS/|],    # list of regexes for the output
        check   => 0,               # check if callbacks got called?
    },
    skipped_test => {
        buffer  => '',
        failed  => 0,
        match   => ['/PASS/',
                    '/tests for this module were skipped during this build/',
                ],
        check   => 0,
        skiptests
                => 1,               # did we skip the tests?
    },                    
    missing_prereq  => {
        buffer  => missing_prereq_buffer(),
        failed  => 1,
        match   => ['/The comments above are created mechanically/',
                    '/computer-generated error report/',
                    '/Below is the error stack from stage/',
                    '/test suite seem to fail without these modules/',
                    '/floo/',
                    '/FAIL/',
                    '/make test/',
                ],
        check   => 1,
    },
    missing_tests   => {
        buffer  => missing_tests_buffer(),
        failed  => 1,
        match   => ['/The comments above are created mechanically/',
                    '/computer-generated error report/',
                    '/Below is the error stack from stage/',
                    '/RECOMMENDATIONS/',
                    '/UNKNOWN/',
                    '/make test/',
                ],
        check   => 0,
    },
    perl_version_too_low_mm => {
        buffer  => perl_version_too_low_buffer_mm(),
        failed  => 1,
        match   => ['/This distribution has been tested/',
                    '/http://testers.cpan.org/',
                    '/NA/',
                ],
        check   => 0,
    },    
    perl_version_too_low_build1 => {
        buffer  => perl_version_too_low_buffer_build(1),
        failed  => 1,
        match   => ['/This distribution has been tested/',
                    '/http://testers.cpan.org/',
                    '/NA/',
                ],
        check   => 0,
    },    
    perl_version_too_low_build2 => {
        buffer  => perl_version_too_low_buffer_build(2),
        failed  => 1,
        match   => ['/This distribution has been tested/',
                    '/http://testers.cpan.org/',
                    '/NA/',
                ],
        check   => 0,
    },    
    prereq_versions_too_low => {
        ### set the prereq version incredibly high
        pre_hook    => sub {
                        my $mod     = shift;
                        my $clone   = $mod->clone;
                        $clone->status->prereqs({ $ModPrereq => $HighVersion });
                        return $clone;
                    },
        failed      => 1,
        match       => ['/This distribution has been tested/',
                        '/http://testers.cpan.org/',
                        '/NA/',
                    ],
        check       => 0,    
    },
    prereq_not_on_cpan => {
        pre_hook    => sub {
                        my $mod     = shift;
                        my $clone   = $mod->clone;
                        $clone->status->prereqs( 
                            { TEST_CONF_INVALID_MODULE, 0 } 
                        );
                        return $clone;
                    },
        failed      => 1,
        match       => ['/This distribution has been tested/',
                        '/http://testers.cpan.org/',
                        '/NA/',
                    ],
        check       => 0,    
    },
    prereq_not_on_cpan_but_core => {
        pre_hook    => sub {
                        my $mod     = shift;
                        my $clone   = $mod->clone;
                        $clone->status->prereqs( 
                            { TEST_CONF_PREREQ, 0 } 
                        );
                        return $clone;
                    },
        failed      => 1,
        match       => ['/This distribution has been tested/',
                        '/http://testers.cpan.org/',
                        '/UNKNOWN/',
                    ],
        check       => 0,    
    },
};

### test config settings 
{   for my $opt ( qw[cpantest cpantest_mx] ) {
        my $warnings;
        local $SIG{__WARN__} = sub { $warnings .= "@_" };

        my $org = $conf->get_conf( $opt );
        ok( $conf->set_conf( $opt => $$ ),
                                "Setting option $opt to $$" );
        is( $conf->get_conf( $opt ), $$,
                                "   Retrieved properly" );
        ok( $conf->set_conf( $opt => $org ),
                                "   Option $opt set back to original" );
        ok( !$warnings,         "   No warnings" );                                
    }
}

### test constants ###
{   {   my $to = CPAN_MAIL_ACCOUNT->('foo');
        is( $to, 'foo@cpan.org',        "Got proper mail account" );
    }

    {   ok(RELEVANT_TEST_RESULT->($Mod),"Test is relevant" );

        ### test non-relevant tests ###
        my $cp = $Mod->clone;
        $cp->module( $Mod->module . '::' . ($^O eq 'beos' ? 'MSDOS' : 'Be') );
        ok(!RELEVANT_TEST_RESULT->($cp),"Test is irrelevant");
    }

    {   my $support = "it works!";
        my @support = ( "No support for OS",
                        "OS unsupported",
                        "os unsupported",
        );
        ok(!UNSUPPORTED_OS->($support), "OS supported");
        ok( UNSUPPORTED_OS->($_),   "OS not supported") for(@support);
    }

    {   ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_mm() ),
                                        "Perl version too low" );
        ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_build(1) ),
                                        "Perl version too low" );
        ok(PERL_VERSION_TOO_LOW->( perl_version_too_low_buffer_build(2) ),
                                        "Perl version too low" );
        ok(!PERL_VERSION_TOO_LOW->('foo'),
                                        "   Perl version adequate" );
    }

    {   my $tests = "test.pl";
        my @none  = (   "No tests defined for Foo extension.",
                        "'No tests defined for Foo::Bar extension.'",
                        "'No tests defined.'",
        );
        ok(!NO_TESTS_DEFINED->($tests), "Tests defined");
        ok( NO_TESTS_DEFINED->($_),  "No tests defined")    for(@none);
    }

    {   my $fail = 'MAKE TEST'; my $unknown = 'foo';
        is( TEST_FAIL_STAGE->($fail), lc $fail,
                                        "Proper test fail stage found" );
        is( TEST_FAIL_STAGE->($unknown), 'fetch',
                                        "Proper test fail stage found" );
    }

    ### test missing prereqs        
    {   my $str = q[Can't locate Foo/Bar.pm in @INC];
    
        ### standard test
        {   my @list = MISSING_PREREQS_LIST->( $str );
            is( scalar(@list),  1,      "   List of missing prereqs found" );
            is( $list[0], 'Foo::Bar',   "       Proper prereq found" );
        }
    
        ### multiple mentions of same prereq
        {   my @list = MISSING_PREREQS_LIST->( $str . $str );

            is( scalar(@list),  1,      "   1 result for multiple mentions" );
            is( $list[0], 'Foo::Bar',   "   Proper prereq found" );
        }
    }

    {                                       # cp version, author
        my $header = REPORT_MESSAGE_HEADER->($int_ver,'foo');
        ok( $header,                    "Test header generated" );
        like( $header, qr/Dear foo,/,   "   Proper content found" );
        like( $header, qr/puter-gen/,   "   Proper content found" );
        like( $header, qr/CPANPLUS,/,   "   Proper content found" );
        like( $header, qr/ments may/,   "   Proper content found" );
    }

    {                                       # stage, buffer
        my $header = REPORT_MESSAGE_FAIL_HEADER->('test','buffer');
        ok( $header,                    "Test header generated" );
        like( $header, qr/uploading/,   "   Proper content found" );
        like( $header, qr/RESULTS:/,    "   Proper content found" );
        like( $header, qr/stack/,       "   Proper content found" );
        like( $header, qr/buffer/,      "   Proper content found" );
    }

    {   my $prereqs = REPORT_MISSING_PREREQS->('foo','bar@example.com','Foo::Bar');
        ok( $prereqs,                   "Test output generated" );
        like( $prereqs, qr/'foo \(bar\@example\.com\)'/, 
                                        "   Proper content found" );
        like( $prereqs, qr/Foo::Bar/,   "   Proper content found" );
        like( $prereqs, qr/prerequisi/, "   Proper content found" );
        like( $prereqs, qr/PREREQ_PM/,  "   Proper content found" );
    }

    {   my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar');    
        ok( $prereqs,                   "Test output generated" );
        like( $prereqs, qr/Your Name/,  "   Proper content found" );
        like( $prereqs, qr/Foo::Bar/,   "   Proper content found" );
        like( $prereqs, qr/prerequisi/, "   Proper content found" );
        like( $prereqs, qr/PREREQ_PM/,  "   Proper content found" );
    }

    {   my $missing = REPORT_MISSING_TESTS->();
        ok( $missing,                   "Missing test string generated" );
        like( $missing, qr/tests/,      "   Proper content found" );
        like( $missing, qr/Test::More/, "   Proper content found" );
    }

    {   my $missing = REPORT_MESSAGE_FOOTER->();
        ok( $missing,                   "Message footer string generated" );
        like( $missing, qr/NOTE/,       "   Proper content found" );
        like( $missing, qr/identical/,  "   Proper content found" );
        like( $missing, qr/mistaken/,   "   Proper content found" );
        like( $missing, qr/appreciate/, "   Proper content found" );
        like( $missing, qr/Additional/, "   Proper content found" );
    }

    {   my @libs = MISSING_EXTLIBS_LIST->("No library found for -lfoo\nNo library found for -lbar");
        ok( @libs,                      "Missing external libraries found" );
        my @list = qw(foo bar);
        is_deeply( \@libs, \@list,      "   Proper content found" );
    }
    
    {   my $clone   = $Mod->clone;

        my $prereqs = { $ModPrereq => $HighVersion };
    
        $clone->status->prereqs( $prereqs );

        my $str = REPORT_LOADED_PREREQS->( $clone );
        
        like($str, qr/PREREQUISITES:/,  "Listed loaded prerequisites" );
        like($str, qr/\! $ModPrereq\s+\S+\s+\S+/,
                                        "   Proper content found" );
    }
}

### callback tests
{   ### as reported in bug 13086, this callback returned the wrong item 
    ### from the list:
    ### $self->_callbacks->munge_test_report->($Mod, $message, $grade);     
    my $rv = $CB->_callbacks->munge_test_report->( 1..4 );   
    is( $rv, 2,                 "Default 'munge_test_report' callback OK" );
}


### test creating test reports ###
SKIP: {
	skip "You have chosen not to enable test reporting", $total_tests,
        unless $CB->configure_object->get_conf('cpantest');

    skip "No report send & query modules installed", $total_tests
        unless $CB->_have_query_report_modules(verbose => 0);


    SKIP: {   
        my $mod = $CB->module_tree( TEST_CONF_PREREQ ); # is released to CPAN
        ok( $mod,                           "Module retrieved" );
        
        ### so we're not pinned down to this specific version of perl
        my @list = $mod->fetch_report( all_versions => 1 );
        skip "Possibly no net connection, or server down", 7 unless @list;
     
        my $href = $list[0];
        ok( scalar(@list),                  "Fetched test report" );
        is( ref $href, ref {},              "   Return value has hashrefs" );

        ok( $href->{grade},                 "   Has a grade" );

        ### XXX use constants for grades?
        like( $href->{grade}, qr/pass|fail|unknown|na/i,
                                            "   Grade as expected" );

        my $pkg_name = $mod->package_name;
        ok( $href->{dist},                  "   Has a dist" );
        like( $href->{dist}, qr/$pkg_name/, "   Dist as expected" );

        ok( $href->{platform},              "   Has a platform" );
    }

    skip "No report sending modules installed", $send_tests
        unless $CB->_have_send_report_modules(verbose => 0);

    for my $type ( keys %$map ) {


        ### never enter the editor for test reports
        ### but check if the callback actually gets called;
        my $called_edit; my $called_send;
        $CB->_register_callback(
            name => 'edit_test_report',
            code => sub { $called_edit++; 0 }
        );

        $CB->_register_callback(
            name => 'send_test_report',
            code => sub { $called_send++; 1 }
        );

		### reset from earlier tests
		$CB->_register_callback(
            name => 'munge_test_report',
            code => sub { return $_[1] }
        );

        my $mod = $map->{$type}->{'pre_hook'}
                    ? $map->{$type}->{'pre_hook'}->( $Mod )
                    : $Mod;

        my $file = do {
            ### so T::R does not try to resolve our maildomain, which can 
            ### lead to large timeouts for *every* invocation in T::R < 1.51_01
            ### see: http://code.google.com/p/test-reporter/issues/detail?id=15
            local $ENV{MAILDOMAIN} ||= 'example.com';
            $CB->_send_report(
                        module        => $mod,
                        buffer        => $map->{$type}{'buffer'},
                        failed        => $map->{$type}{'failed'},
                        tests_skipped => ($map->{$type}{'skiptests'} ? 1 : 0),
                        save          => 1,
                    );
        };

        ok( $file,              "Type '$type' written to file" );
        ok( -e $file,           "   File exists" );

        my $fh = FileHandle->new($file);
        ok( $fh,                "   Opened file for reading" );

        my $in = do { local $/; <$fh> };
        ok( $in,                "   File has contents" );

        for my $regex ( @{$map->{$type}->{match}} ) {
            like( $in, $regex,  "   File contains expected contents" );
        }

        ### check if our registered callback got called ###
        if( $map->{$type}->{check} ) {
            ok( $called_edit,   "   Callback to edit was called" );
            ok( $called_send,   "   Callback to send was called" );
        }

        #unlink $file;


### T::R tests don't even try to mail, let's not try and be smarter
### ourselves
#        {   ### use a dummy 'editor' and see if the editor
#            ### invocation doesn't break things
#            $conf->set_program( editor => "$^X -le1" );
#            $CB->_callbacks->edit_test_report( sub { 1 } );
#
#            ### XXX whitebox test!!! Might change =/
#            ### this makes test::reporter not ask for what editor to use
#            ### XXX stupid lousy perl warnings;
#            local $Test::Reporter::MacApp = 1;
#            local $Test::Reporter::MacApp = 1;
#
#            ### now try and mail the report to a /dev/null'd mailbox
#            my $ok = $CB->_send_report(
#                            module  => $Mod,
#                            buffer  => $map->{$type}->{'buffer'},
#                            failed  => $map->{$type}->{'failed'},
#                            address => NOBODY,
#                        );
#            ok( $ok,                "   Mailed report to NOBODY" );
#       }
    }
}


sub missing_prereq_buffer {
    return q[
MAKE TEST:
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 .).
BEGIN failed--compilation aborted.
    ];
}

sub missing_tests_buffer {
    return q[
cp lib/Acme/POE/Knee.pm blib/lib/Acme/POE/Knee.pm
cp demo_race.pl blib/lib/Acme/POE/demo_race.pl
cp demo_simple.pl blib/lib/Acme/POE/demo_simple.pl
MAKE TEST:
No tests defined for Acme::POE::Knee extension.
    ];
}

sub perl_version_too_low_buffer_mm {
    return q[
Running [/usr/bin/perl5.8.1 Makefile.PL ]...
Perl v5.8.3 required--this is only v5.8.1, stopped at Makefile.PL line 1.
BEGIN failed--compilation aborted at Makefile.PL line 1.
[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.
BEGIN failed--compilation aborted at Makefile.PL line 1.
 -- cannot continue
    ];
}    

sub perl_version_too_low_buffer_build {
    my $type = shift;
    return q[
ERROR: perl: Version 5.006001 is installed, but we need version >= 5.008001
ERROR: version: Prerequisite version isn't installed
ERRORS/WARNINGS FOUND IN PREREQUISITES.  You may wish to install the versions
 of the modules indicated above before proceeding with this installation.
    ]   if($type == 1);
    return q[
ERROR: Version 5.006001 of perl is installed, but we need version >= 5.008001
ERROR: version: Prerequisite version isn't installed
ERRORS/WARNINGS FOUND IN PREREQUISITES.  You may wish to install the versions
 of the modules indicated above before proceeding with this installation.
    ]   if($type == 2);
}    

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
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	}
	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
4443dd53	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(
6aaee015	387	module => $mod,
	388	buffer => $map->{$type}{'buffer'},
	389	failed => $map->{$type}{'failed'},
	390	tests_skipped => ($map->{$type}{'skiptests'} ? 1 : 0),
	391	save => 1,
6aaee015	392	);
4443dd53	393	};
6aaee015	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,
6aaee015	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: