#!perl use strict; BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } } select(STDERR); $|=1; select(STDOUT); $|=1; use Test::More; use t::MockCPANDist; use t::Helper; use t::Frontend; use Config; my @prereq_cases = ( #module #need #have #ok? [ 'Bogus::Found', 1.23, 3.14, 1 ], [ 'Bogus::Shadow', 3.14, 3.14, 1 ], [ 'Bogus::NotFound', 1.49, "n/a", 0 ], [ 'Bogus::TooOld', 2.72, 0.01, 0 ], [ 'Bogus::NoVersion', 0, 0, 1 ], [ 'Bogus::GTE', '>= 3.14', 3.14, 1 ], [ 'Bogus::GT', '>3.14', 3.14, 0 ], [ 'Bogus::LTE', '<= 3.15', 3.14, 1 ], [ 'Bogus::LT', '<3.14', 3.14, 0 ], [ 'Bogus::Conflict', '!= 3.14', 3.14, 0 ], [ 'Bogus::Complex', '>= 3, !=3.14, < 4', 3.14, 0 ], [ 'Bogus::Broken', '0', 'broken', 0 ], [ 'perl', 5.00, $], 1 ], ); my @scenarios = ( [ "old CPAN-style", undef ], # undef is signal and helps keep count [ "only one", qw/requires/ ], [ "only one", qw/build_requires/ ], [ "both types", qw/requires build_requires/ ], ); my $scenario_count; $scenario_count += @$_ - 1 for @scenarios; plan tests => 2 + test_fake_config_plan() + $scenario_count * ( 1 + 4 * @prereq_cases ); #--------------------------------------------------------------------------# # Fixtures #--------------------------------------------------------------------------# my %prereq_pm = map { @{$_}[0,1] } @prereq_cases; my ($module_width, $prereq_width) = (0,0); for my $case ( @prereq_cases ) { $module_width = length $case->[0] if length $case->[0] > $module_width; $prereq_width = length $case->[1] if length $case->[1] > $prereq_width; } my $expect_regex = '\s+(!|\s)\s' . '(.{' . $module_width . '})\s' . '(.{' . $prereq_width . '})\s(\S+)'; # \s+ leading spaces # (!|\s) capture bang or space # \s separator space # (.{N}) module name # \s separator space # (.{N}) module version needed # \s separator space # (\S+) module version found my @mock_defaults = ( pretty_id => "JOHNQP/Bogus-Module-1.23.tar.gz", author_id => "JOHNQP", author_fullname => "John Q. Public", ); my ($got, @got, $expect); #--------------------------------------------------------------------------# # Begin tests #--------------------------------------------------------------------------# my $perl5lib = File::Spec->rel2abs( File::Spec->catdir( qw/ t perl5lib / ) ); my $shadowlib = File::Spec->rel2abs( File::Spec->catdir( qw/ t perl5lib-shadow / ) ); local $ENV{PERL5LIB} = join $Config{path_sep}, $perl5lib, $shadowlib, $ENV{PERL5LIB}; require_ok('CPAN::Reporter'); test_fake_config(); #--------------------------------------------------------------------------# # Test no prereq #--------------------------------------------------------------------------# { my $mock_dist = t::MockCPANDist->new( @mock_defaults, prereq_pm => { }, ); $got = CPAN::Reporter::_prereq_report( $mock_dist ); like( $got, '/^\s*No requirements found\s*$/ms', "No requirements specified message correct" ); } #--------------------------------------------------------------------------# # Scenario testing #--------------------------------------------------------------------------# for my $scene ( @scenarios ) { my ($label, @keys ) = @$scene; # initialize -- we need to have both keys for CPAN::Reporter # to detect new CPAN style my %scenario_prereq = ( requires => undef, build_requires => undef, ); # load up prereqs into one or more keys (new style) or replace # %scenario_prereq if old, flat style if ( @keys ) { if ( defined $keys[0] ) { $scenario_prereq{$_} = { %prereq_pm } for @keys; } else { # do it old style, but set up $keys[0] to act like "requires" # for analysis of output %scenario_prereq = %prereq_pm; $keys[0] = 'requires'; } } my $mock_dist = t::MockCPANDist->new( @mock_defaults, prereq_pm => { %scenario_prereq }, ); $got = CPAN::Reporter::_prereq_report( $mock_dist ); # diag $got; @got = split /\n+/ms, $got; for my $prereq_type ( @keys ) { like( shift( @got), '/^' . $prereq_type . ':\s*$/ms', "$label: '$prereq_type' header" ); # Dump header lines splice( @got, 0, 2 ); for my $case ( sort { lc $a->[0] cmp lc $b->[0] } @prereq_cases ) { my ($exp_module, $exp_need, $exp_have, $exp_ok) = @$case; my $line = shift(@got); my ($bang, $module, $need, $have) = ( $line =~ /^$expect_regex\s*$/ms ); # trim trailing spaces from fixed-width captures $module =~ s/\s*$//; $need =~ s/\s*$//; is( $module, $exp_module, "$label ($prereq_type): found '$exp_module' in report" ); is( $bang, ($exp_ok ? ' ' : '!'), "$label ($prereq_type): '$exp_module' flag correct" ) or diag "LINE: $line"; is( $exp_need, $need, "$label ($prereq_type): '$exp_module' needed version correct" ) or diag "LINE: $line"; # Check numerically, too, since version.pm/bleadperl will make # 1.2 into 1.200 ok( $exp_have eq $have || $exp_have == $have, "$label ($prereq_type): '$exp_module' installed version correct" ) or diag "LINE: $line"; } } }