App-Project-Doctor
view release on metacpan or search on metacpan
t/integration.t view on Meta::CPAN
# Build a temp directory tree from a %{ rel_path => content } hash.
sub _make_distro {
my (%files) = @_;
my $dir = tempdir(CLEANUP => 1);
for my $rel (sort keys %files) {
my @parts = split m{/}, $rel;
my $abs = File::Spec->catfile($dir, @parts);
make_path(dirname($abs)) unless -d dirname($abs);
open my $fh, '>', $abs or die "Cannot write $abs: $!";
print $fh $files{$rel};
close $fh;
}
return $dir;
}
# Create a Finding with the given named args.
sub _f {
return $Finding->new(@_);
}
# Build a Report containing $n fixable error findings.
# Each fix coderef appends "fixN" to @{$applied_ref}.
sub _report_with_fixable {
my ($applied_ref, $n) = @_;
my $report = $Report->new;
for my $i (1 .. $n) {
my $idx = $i;
$report->add_findings(_f(
severity => 'error',
message => "Fix me $idx",
check_name => 'Test',
fix => sub { push @{$applied_ref}, "fix$idx" },
));
}
return $report;
}
# Run Fixer interactively, supplying $input via a string-ref STDIN.
# Suppresses Fixer output unless $ENV{TEST_VERBOSE}.
sub _interactive_fixer {
my ($input, $applied_ref) = @_;
my $dir = tempdir(CLEANUP => 1);
my $ctx = $Context->new(root => $dir);
my $report = _report_with_fixable($applied_ref, 3);
my $fixer = $Fixer->new(report => $report, context => $ctx);
my ($count, $out);
{
open(local *STDOUT, '>', \$out) or die "Cannot redirect STDOUT: $!";
open(local *STDIN, '<', \$input) or die "Cannot redirect STDIN: $!";
$count = $fixer->run;
}
diag "Fixer output:\n$out" if $ENV{TEST_VERBOSE} && $out;
return $count;
}
# ─────────────────────────────────────────────────────────────────────────────
# 1. FINDING -> REPORT ACCUMULATION
# Strategy: Exercise the full Finding+Report pipeline by creating all four
# severity types and verifying that each filter method is independently correct.
# A passing report and a failing report are tested to ensure exit_code and the
# has_* predicates agree.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'finding-report accumulation across all severity types' => sub {
my $fix_called = 0;
my $report = $Report->new;
$report->add_findings(
_f(severity => 'error', message => 'E1', check_name => 'A'),
_f(severity => 'error', message => 'E2', check_name => 'A'),
_f(severity => 'warning', message => 'W1', check_name => 'B'),
_f(severity => 'pass', message => 'P1', check_name => 'C'),
_f(severity => 'info', message => 'I1', check_name => 'D'),
_f(severity => 'error', message => 'E_fix', check_name => 'E',
fix => sub { $fix_called++ }),
);
is( scalar($report->all_findings), 6, 'six findings accumulated' );
is( scalar($report->errors), 3, 'three errors' );
is( scalar($report->warnings), 1, 'one warning' );
is( scalar($report->passes), 1, 'one pass' );
is( scalar($report->fixable), 1, 'one fixable finding' );
ok( $report->has_errors, 'has_errors is true' );
ok( $report->has_warnings, 'has_warnings is true' );
is( $report->exit_code, 1, 'exit_code 1 when errors present' );
diag 'findings: ' . join(', ', map { $_->message } $report->all_findings)
if $ENV{TEST_VERBOSE};
};
subtest 'report exit_code is 0 and has_errors is false with only warnings' => sub {
my $report = $Report->new;
$report->add_findings(
_f(severity => 'warning', message => 'W1', check_name => 'X'),
_f(severity => 'pass', message => 'P1', check_name => 'X'),
);
is( $report->exit_code, 0, 'exit_code 0 when no errors present' );
ok( !$report->has_errors, 'has_errors false when no errors' );
ok( $report->has_warnings, 'has_warnings true when warning present' );
};
subtest 'add_findings returns $self for method chaining' => sub {
my $r1 = $Report->new;
my $r2 = $r1->add_findings(_f(severity => 'info', message => 'X', check_name => 'T'));
is( $r2, $r1, 'add_findings returns the same report object' );
};
subtest 'add_findings croaks on non-Finding arguments' => sub {
my $report = $Report->new;
throws_ok { $report->add_findings('plain string') }
qr/Expected an App::Project::Doctor::Finding/,
'croaks when passed a plain string';
throws_ok { $report->add_findings(bless {}, 'SomeOtherClass') }
qr/Expected an App::Project::Doctor::Finding/,
'croaks when passed a wrong blessed object';
is( scalar($report->all_findings), 0, 'no findings accumulated after failed adds' );
};
# ─────────────────────────────────────────────────────────────────────────────
t/integration.t view on Meta::CPAN
'MANIFEST' => "MANIFEST\n",
'README' => "My Module\n",
);
my $doctor = $Doctor->new(path => $dir, checks => ['CpanReadiness']);
my $report = $doctor->run;
ok( $report->has_errors, 'error raised when version does not match CPAN format' );
my ($ver_err) = grep { $_->message =~ /\Q$INVALID_VERSION\E/ } $report->errors;
ok( $ver_err, "error finding mentions the invalid version string '$INVALID_VERSION'" );
diag 'error: ' . ($ver_err ? $ver_err->message : 'none') if $ENV{TEST_VERBOSE};
};
# ─────────────────────────────────────────────────────────────────────────────
# 9. DOCTOR SKIP AND CHECKS PARAMETERS
# Strategy: The 'skip' list and the 'checks' list control which plugins run.
# Skipping CpanReadiness must produce zero CpanReadiness findings, even when
# the distro is missing required files. Restricting to 'checks => [Security]'
# must produce no findings from other check classes.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'doctor skip parameter prevents skipped check from adding findings' => sub {
# Distro is deliberately missing Changes/MANIFEST/README so CpanReadiness
# WOULD emit errors -- but we skip it.
my $dir = _make_distro(
'Makefile.PL' => "use ExtUtils::MakeMaker;\n",
'lib/My/Module.pm' => "package My::Module;\nuse strict;\nuse warnings;\nour \$VERSION = '$VALID_VERSION';\n1;\n",
);
my $doctor = $Doctor->new(
path => $dir,
checks => [qw(Security CpanReadiness)],
skip => ['CpanReadiness'],
);
my $report = $doctor->run;
my @cpan = grep { $_->check_name eq 'CPAN Readiness' } $report->all_findings;
is( scalar @cpan, 0, 'zero CPAN Readiness findings when check is skipped' );
};
subtest 'doctor checks parameter restricts pipeline to named check only' => sub {
my $dir = _make_distro(
'Makefile.PL' => "use ExtUtils::MakeMaker;\n",
'lib/My/Module.pm' => "package My::Module;\nuse strict;\nuse warnings;\nour \$VERSION = '$VALID_VERSION';\n1;\n",
'Changes' => "1.00 2026-06-30\n - Initial.\n",
'MANIFEST' => "MANIFEST\n",
'README' => "My Module\n",
);
my $doctor = $Doctor->new(path => $dir, checks => ['Security']);
my $report = $doctor->run;
my @non_security = grep { $_->check_name ne 'Security' } $report->all_findings;
is( scalar @non_security, 0, 'no findings from other check classes when checks => [Security]' );
ok( scalar($report->all_findings) > 0, 'at least one Security finding present' );
};
# ─────────────────────────────────────────────────────────────────────────────
# 10. SECURITY CHECK INTEGRATION
# Strategy: Run Check::Security directly on crafted distros to verify the
# strict/warnings detection produces a fixable error finding that correctly
# identifies the source file. A clean file must yield only a pass finding.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'security check detects missing "use strict" and produces fixable error' => sub {
require App::Project::Doctor::Check::Security;
my $dir = _make_distro(
'lib/Broken.pm' => "package Broken;\nuse warnings;\n1;\n",
);
my $ctx = $Context->new(root => $dir);
my $check = App::Project::Doctor::Check::Security->new;
my @findings = $check->check($ctx);
my ($strict_err) = grep { $_->message =~ /use strict/i } @findings;
ok( $strict_err, 'error finding produced for missing use strict' );
is( $strict_err->severity, 'error', 'severity is error' );
ok( $strict_err->is_fixable, 'finding carries an automated fix coderef' );
like($strict_err->file, qr/Broken\.pm/, 'file attribute identifies the broken file' );
diag 'finding: ' . $strict_err->message if $ENV{TEST_VERBOSE} && $strict_err;
};
subtest 'security check emits a pass finding for a clean module' => sub {
require App::Project::Doctor::Check::Security;
my $dir = _make_distro(
'lib/Clean.pm' => "package Clean;\nuse strict;\nuse warnings;\n1;\n",
);
my $ctx = $Context->new(root => $dir);
my $check = App::Project::Doctor::Check::Security->new;
my @findings = $check->check($ctx);
my ($pass) = grep { $_->severity eq 'pass' } @findings;
ok( $pass, 'a pass finding emitted for a clean module' );
is( scalar(grep { $_->severity eq 'error' } @findings), 0, 'no error findings' );
};
# ─────────────────────────────────────────────────────────────────────────────
# 11. DEPENDENCIES CHECK + FIX INTEGRATION
# Strategy: Exercise the multi-step Check::Dependencies workflow:
# (a) detect an undeclared module -> error + fixable finding
# (b) apply the fix -> cpanfile updated on disk
# (c) re-run check -> pass finding
# (d) App::makefilepl2cpanfile absent -> graceful warning, not a crash
# ─────────────────────────────────────────────────────────────────────────────
subtest 'dependencies check detects used module not in cpanfile' => sub {
require App::Project::Doctor::Check::Dependencies;
my $dir = _make_distro(
'cpanfile' => "# intentionally empty\n",
'lib/My/M.pm' => "package My::M;\nuse strict;\nuse warnings;\nuse $SOME_MOD;\n1;\n",
);
my $ctx = $Context->new(root => $dir);
my $check = App::Project::Doctor::Check::Dependencies->new;
my @findings = $check->check($ctx);
t/integration.t view on Meta::CPAN
my $content = $ctx->slurp('cpanfile');
like( $content, qr/requires '$ANOTHER_MOD'/,
"cpanfile contains requires '$ANOTHER_MOD' after fix applied" );
diag "cpanfile after fix:\n$content" if $ENV{TEST_VERBOSE};
};
subtest 'dependencies check passes when all used modules are declared' => sub {
require App::Project::Doctor::Check::Dependencies;
my $dir = _make_distro(
'cpanfile' => "requires '$SOME_MOD';\n",
'lib/My/M.pm' => "package My::M;\nuse strict;\nuse warnings;\nuse $SOME_MOD;\n1;\n",
);
my $ctx = $Context->new(root => $dir);
my $check = App::Project::Doctor::Check::Dependencies->new;
my @findings = $check->check($ctx);
my ($pass) = grep { $_->severity eq 'pass' } @findings;
ok( $pass, 'pass finding when all deps are declared' );
is( scalar(grep { $_->severity eq 'error' } @findings), 0, 'no error findings' );
};
subtest 'dependencies check degrades gracefully when App::makefilepl2cpanfile fails' => sub {
require App::Project::Doctor::Check::Dependencies;
require App::makefilepl2cpanfile;
# Only Makefile.PL present -- the module path requires App::makefilepl2cpanfile.
my $dir = _make_distro(
'Makefile.PL' => "use ExtUtils::MakeMaker;\n",
'lib/My/M.pm' => "package My::M;\nuse strict;\nuse warnings;\n1;\n",
);
my $ctx = $Context->new(root => $dir);
my $check = App::Project::Doctor::Check::Dependencies->new;
# Simulate generate() failing (equivalent to the module being uninstalled).
# mock_scoped is portable across all Perl versions; Test::Without::Module +
# local %INC manipulation is not reliable when 'use' is evaluated at runtime.
my $g = mock_scoped 'App::makefilepl2cpanfile::generate'
=> sub { die "Simulated: App::makefilepl2cpanfile unavailable\n" };
my (@findings, @carped);
{
local $SIG{__WARN__} = sub { push @carped, $_[0] };
@findings = eval { $check->check($ctx) };
}
ok( !$@, 'check does not throw when generate() fails' );
is( scalar @findings, 1, 'exactly one finding returned' );
is( $findings[0]->severity, 'warning', 'finding is a warning, not an exception' );
ok( scalar @carped, 'carp was called to report the failure' );
diag 'warning: ' . $findings[0]->message if $ENV{TEST_VERBOSE};
diag 'carped: ' . $carped[0] if $ENV{TEST_VERBOSE} && @carped;
};
# ─────────────────────────────────────────────────────────────────────────────
# 12. CONCURRENT OBJECT NON-INTERFERENCE
# Strategy: Create two independent instances of the same class within the same
# test block and verify they accumulate state in isolation -- no shared %INC
# side effects, no shared internal _findings arrays between Report instances,
# and no cross-contamination between Doctor runs on different distros.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'two concurrent Report instances accumulate state independently' => sub {
my $report_a = $Report->new;
my $report_b = $Report->new;
$report_a->add_findings(_f(severity => 'error', message => 'Err A', check_name => 'A'));
$report_b->add_findings(_f(severity => 'warning', message => 'Warn B', check_name => 'B'));
is( scalar($report_a->all_findings), 1, 'report_a has exactly one finding' );
is( scalar($report_b->all_findings), 1, 'report_b has exactly one finding' );
is( scalar($report_a->errors), 1, 'report_a: one error' );
is( scalar($report_b->errors), 0, 'report_b: no errors (its finding is a warning)' );
is( scalar($report_b->warnings), 1, 'report_b: one warning' );
is( $report_a->exit_code, 1, 'report_a exit_code is 1' );
is( $report_b->exit_code, 0, 'report_b exit_code is 0' );
diag sprintf('report_a exit=%d report_b exit=%d', $report_a->exit_code, $report_b->exit_code)
if $ENV{TEST_VERBOSE};
};
subtest 'two concurrent Doctor instances operate on separate distros without interference' => sub {
# doc_bad points at a distro with an invalid version string -> errors.
# doc_good points at a distro with a valid version string -> no errors.
my $dir_bad = _make_distro(
'Makefile.PL' => "use ExtUtils::MakeMaker;\n",
'lib/M.pm' => "package M;\nour \$VERSION = '$INVALID_VERSION';\n1;\n",
'Changes' => "1.00 2026-06-30\n - Initial.\n",
'MANIFEST' => "MANIFEST\n",
'README' => "M\n",
);
my $dir_good = _make_distro(
'Makefile.PL' => "use ExtUtils::MakeMaker;\n",
'lib/M.pm' => "package M;\nour \$VERSION = '$VALID_VERSION';\n1;\n",
'Changes' => "1.00 2026-06-30\n - Initial.\n",
'MANIFEST' => "MANIFEST\n",
'README' => "M\n",
);
my $doc_bad = $Doctor->new(path => $dir_bad, checks => ['CpanReadiness']);
my $doc_good = $Doctor->new(path => $dir_good, checks => ['CpanReadiness']);
my $report_bad = $doc_bad->run;
my $report_good = $doc_good->run;
ok( $report_bad->has_errors, 'invalid distro report has errors' );
ok( !$report_good->has_errors, 'valid distro report has no errors' );
is( $report_bad->exit_code, 1, 'bad distro exit_code is 1' );
is( $report_good->exit_code, 0, 'good distro exit_code is 0' );
diag sprintf("bad=%d good=%d", $report_bad->exit_code, $report_good->exit_code)
if $ENV{TEST_VERBOSE};
};
# ─────────────────────────────────────────────────────────────────────────────
# 13. SPY: VERIFY EXTERNAL CALL ARGUMENTS
# Strategy: Use Test::Mockingbird::Spy on App::makefilepl2cpanfile::generate to
# confirm that Check::Dependencies passes the correct absolute Makefile.PL path
( run in 0.488 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )