TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 100.0% (3/3)
Approximate LCSAJ segments: 9
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package App::Project::Doctor::Check::Tests; 2: 3: # This check verifies that the distribution has a working test suite. 4: # It runs in three stages: (1) does t/ exist? (2) are there .t files? 5: # (3) does 'prove -l' exit 0? The first two failures are auto-fixable. 6: 7: use strict; 8: use warnings; 9: use autodie qw(:all); 10: 11: # Inherit the standard interface from Check::Base. 12: use parent -norequire, 'App::Project::Doctor::Check::Base'; 13: 14: # croak reports errors at the caller's location, not inside this module. 15: use Carp qw(croak carp); 16: # File::Path::make_path creates directory trees in the fix closure. 17: use File::Path (); 18: # File::Spec builds cross-platform file paths (forward slashes on Windows too). 19: use File::Spec; 20: # Readonly makes constants truly immutable at runtime. 21: use Readonly; 22: 23: our $VERSION = '0.02'; 24: 25: # The prove command to run. --nocolor avoids ANSI codes in the captured output. 26: Readonly::Scalar my $PROVE_CMD => 'prove -l --nocolor 2>&1'; 27: 28: # Short name used in Finding.check_name and report column headings. 29: sub name { 'Tests' } 30: # One-line description shown in verbose / help output. 31: sub description { 'Test suite exists, contains .t files, and passes cleanly.' } 32: # This check can offer an automated fix (scaffold a smoke test). 33: sub can_fix { 1 } 34: # Run first; everything else depends on a working test suite. 35: sub order { 10 } 36: 37: sub check { ●38 → 45 → 57 38: my ($self, $ctx) = @_; 39: # Require a Context object so we can use its filesystem helpers. 40: croak 'check requires an App::Project::Doctor::Context' unless ref $ctx; 41: 42: # ----------------------------------------------------------------------- 43: # Stage 1: the t/ directory must exist. 44: # ----------------------------------------------------------------------- 45: unless ($ctx->has_file('t')) {Mutants (Total: 1, Killed: 1, Survived: 0)
46: # No t/ at all -- return immediately with a fixable error. 47: return _f(
Mutants (Total: 2, Killed: 2, Survived: 0)
48: severity => 'error', 49: message => 'No t/ directory -- distribution has no test suite.', 50: fix => _fix_scaffold($ctx), 51: ); 52: } 53: 54: # ----------------------------------------------------------------------- 55: # Stage 2: at least one .t file must be in t/. 56: # ----------------------------------------------------------------------- ●57 → 58 → 72 57: my $test_files = $ctx->test_files; 58: unless (@{$test_files}) {
Mutants (Total: 1, Killed: 1, Survived: 0)
59: # The directory exists but is empty of test files. 60: return _f(
Mutants (Total: 2, Killed: 2, Survived: 0)
61: severity => 'error', 62: message => 't/ directory exists but contains no .t files.', 63: fix => _fix_scaffold($ctx), 64: ); 65: } 66: 67: # ----------------------------------------------------------------------- 68: # Stage 3: run prove and check the exit status. 69: # ----------------------------------------------------------------------- 70: # We use Perl's chdir instead of shell 'cd && prove' because quotemeta 71: # on a Windows path (C:\Tmp) produces C\:\\Tmp which cmd.exe rejects. ●72 → 80 → 90 72: my $root = $ctx->root; 73: require Cwd; 74: my $orig = Cwd::cwd(); # Save the current directory so we can restore it. 75: chdir $root; 76: my $output = qx{$PROVE_CMD}; # Capture all prove output for the detail field. 77: my $status = $?; # $? holds the child process exit status. 78: chdir $orig; # Always restore the working directory. 79: 80: if ($status != 0) {
Mutants (Total: 2, Killed: 2, Survived: 0)
81: # prove reported failures; include the captured output as detail. 82: return _f(
Mutants (Total: 2, Killed: 2, Survived: 0)
83: severity => 'error', 84: message => sprintf('Test suite FAILED (%d file(s) with failures).', scalar @{$test_files}), 85: detail => $output, 86: ); 87: } 88: 89: # All stages passed -- report success with the file count. 90: return _f(
Mutants (Total: 2, Killed: 2, Survived: 0)
91: severity => 'pass', 92: message => sprintf('%d test file(s) found -- all pass.', scalar @{$test_files}), 93: ); 94: } 95: 96: # --------------------------------------------------------------------------- 97: # Private helpers 98: # --------------------------------------------------------------------------- 99: 100: # Purpose: Build a Finding with check_name pre-filled to 'Tests'. 101: # Entry: %args is a valid Finding constructor argument list. 102: # Exit: App::Project::Doctor::Finding object. 103: # Side effects: None. 104: sub _f { 105: require App::Project::Doctor::Finding; 106: return App::Project::Doctor::Finding->new(check_name => 'Tests', @_);
Mutants (Total: 2, Killed: 2, Survived: 0)
107: } 108: 109: # Purpose: Return a coderef that creates a minimal t/00-smoke.t scaffold. 110: # Entry: $ctx is the current App::Project::Doctor::Context. 111: # Exit: Coderef ($ctx) -> void; creates t/ and t/00-smoke.t on disk. 112: # Side effects: Creates directories and files under $ctx->root. 113: sub _fix_scaffold { 114: my $ctx = shift; 115: # Return the fix as a closure so it captures $ctx without running now. 116: return sub {
Mutants (Total: 2, Killed: 2, Survived: 0)
117: # Build the absolute path to the t/ directory. 118: my $t_dir = File::Spec->catdir($ctx->root, 't'); 119: # make_path creates the directory and any missing parent directories. 120: File::Path::make_path($t_dir); 121: # The smoke test file that will be written. 122: my $smoke = File::Spec->catfile($t_dir, '00-smoke.t'); 123: open my $fh, '>', $smoke; 124: # Write a minimal but valid Test::More script that always passes. 125: print {$fh} <<'END_SMOKE'; 126: use strict; 127: use warnings; 128: use Test::More; 129: 130: ok(1, 'module loads'); 131: done_testing; 132: END_SMOKE 133: close $fh; 134: }; 135: } 136: 137: 1; 138: 139: __END__ 140: 141: =head1 NAME 142: 143: App::Project::Doctor::Check::Tests - Check that a test suite exists and passes 144: 145: =head1 VERSION 146: 147: 0.02 148: 149: =head1 SYNOPSIS 150: 151: my $check = App::Project::Doctor::Check::Tests->new; 152: my @findings = $check->check($ctx); 153: 154: =head1 DESCRIPTION 155: 156: Three-stage check: (1) C<t/> directory present, (2) at least one C<.t> file 157: present, (3) C<prove -l> exits 0. A missing test suite generates a fixable 158: finding that creates a minimal C<t/00-smoke.t> scaffold. 159: 160: =head1 METHODS 161: 162: =head2 check( $context ) 163: 164: =head3 API SPECIFICATION 165: 166: =head4 Input 167: 168: $context : App::Project::Doctor::Context 169: 170: =head4 Output 171: 172: List of App::Project::Doctor::Finding (at most one per stage) 173: 174: =head3 MESSAGES 175: 176: Code | Trigger | Resolution 177: -----|-----------------------------|----------------------------------------- 178: T001 | t/ missing | Fix creates t/ and a minimal t/00-smoke.t 179: T002 | t/ present, no .t files | Fix creates a minimal t/00-smoke.t 180: T003 | prove exits non-zero | Fix failing tests manually 181: 182: =head3 FORMAL SPECIFICATION 183: 184: check : Context -> [Finding] 185: check ctx == 186: if not exists "t/" then [error+fix] 187: else if |test_files| = 0 then [error+fix] 188: else if prove_fails then [error] 189: else [pass] 190: 191: =head1 AUTHOR 192: 193: Nigel Horne C<< <njh@nigelhorne.com> >> 194: 195: =head1 LICENSE 196: 197: Copyright (C) 2026 Nigel Horne. 198: This library is free software; you can redistribute it and/or modify 199: it under the same terms as Perl itself. 200: 201: =cut