Survived (tests missed this)
Killed (tests detected this)
No mutation
1: package Devel::App::Test::Generator::LCSAJ::Runtime;
2:
3: use strict;
4: use warnings;
5: use autodie qw(open close);
6: use Carp qw(croak);
7: use Cwd qw(abs_path);
8: use JSON::MaybeXS;
9: use File::Path qw(make_path);
10: use Readonly;
11:
12: # --------------------------------------------------
13: # Output directory for per-process hit JSON files.
14: # One file is written per process (PID) so parallel
15: # test runs do not overwrite each other's output.
16: # --------------------------------------------------
17: Readonly my $OUT_DIR => 'cover_html/lcsaj_hits';
18:
19: our $VERSION = '0.36';
20:
21: =head1 NAME
22:
23: Devel::App::Test::Generator::LCSAJ::Runtime - Debugger backend for LCSAJ coverage
24:
25: =head1 SYNOPSIS
26:
27: PERL5OPT='-d:App::Test::Generator::LCSAJ::Runtime -Mblib' prove -l t
28:
29: =head1 DESCRIPTION
30:
31: This module is loaded as a Perl debugger backend using the C<-d:Module> flag.
32:
33: When Perl sees C<-d:App::Test::Generator::LCSAJ::Runtime> it prepends C<Devel::>
34: and loads C<Devel/App/Test/Generator/LCSAJ/Runtime.pm> from C<@INC>. The file
35: must therefore live at that path — typically
36: C<lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm>.
37:
38: Perl automatically calls C<DB::DB> before executing each statement while the
39: debugger is active. We record (file, line) pairs to build runtime hit data for
40: later LCSAJ analysis.
41:
42: Results are written to C<cover_html/lcsaj_hits/hits_PID.json> at process exit,
43: one file per process so that parallel test runs do not overwrite each other.
44:
45: =head1 ENVIRONMENT
46:
47: =over 4
48:
49: =item LCSAJ_TARGETS
50:
51: Optional colon-separated list of B<absolute> paths (as produced by C<realpath>)
52: to restrict recording to specific source files. When empty or unset every
53: non-internal file is recorded.
54:
55: =back
56:
57: =cut
58:
59: # --------------------------------------------------
60: # %HITS - { normalised_path => { line_number => hit_count } }
61: # %TARGET - set of normalised paths to record (empty means record everything)
62: #
63: # These must be package globals (our) rather than lexicals because DB::DB
64: # is called by the Perl debugger infrastructure and needs to access them
65: # without a closure. Lexical vars would not be visible in DB::DB.
66: # --------------------------------------------------
67: our %HITS;
68: our %TARGET;
69:
70: # --------------------------------------------------
71: # Populate %TARGET from LCSAJ_TARGETS at compile time.
72: # The env var contains absolute realpath() output
73: # separated by colons. Stray newlines from broken
74: # shell pipelines are stripped defensively.
75: # --------------------------------------------------
76: BEGIN {
●[NOT COVERED] 77 → 80 → 0 77: my $targets_env = $ENV{LCSAJ_TARGETS} // '';
78: $targets_env =~ s/\n//g;
79:
80: for my $t (split /:/, $targets_env) {
81: next unless length $t;
82:
83: # Inline normalisation — cannot call _normalize here since
84: # BEGIN runs before named subs are compiled when BEGIN
85: # appears at the top of the file
86: my $f = $t;
87: $f =~ s{^.*/blib/lib/}{lib/};
88: $f =~ s{^.*/lib/}{lib/};
89: $TARGET{$f} = 1;
90: }
91: }
92:
93: END {
94: _write_results();
95: }
96:
97: # --------------------------------------------------
98: # _normalize
99: #
100: # Purpose: Convert an absolute or build-tree path
101: # to a canonical lib-relative form so that
102: # paths recorded at runtime match the
103: # targets derived from LCSAJ_TARGETS.
104: #
105: # Entry: $path - an absolute or relative file path.
106: #
107: # Exit: Returns a lib-relative path string,
108: # e.g. lib/Foo/Bar.pm
109: #
110: # Side effects: None.
111: #
112: # Notes: Must be defined before the BEGIN block
113: # that calls it, since BEGIN runs at compile
114: # time and later subs may not yet be compiled.
115: #
116: # Examples:
117: # /home/user/proj/blib/lib/Foo/Bar.pm -> lib/Foo/Bar.pm
118: # /home/user/proj/lib/Foo/Bar.pm -> lib/Foo/Bar.pm
119: # --------------------------------------------------
120: sub _normalize {
121: my $f = $_[0];
122:
123: # Strip everything up to and including blib/lib/ or lib/
124: $f =~ s{^.*/blib/lib/}{lib/};
125: $f =~ s{^.*/lib/}{lib/};
126: return $f;
Mutants (Total: 2, Killed: 0, Survived: 2)
BOOL_NEGATE_126_2: Negate boolean return expression MEDIUM: Add tests asserting both true and false outcomes
127: }
128:
129: # --------------------------------------------------
130: # DB::DB
131: #
132: # Purpose: Called by the Perl debugger before every
133: # statement. Records (file, line) hits for
134: # later LCSAJ coverage analysis.
135: #
136: # Entry: No arguments — caller(0) is used to get
137: # the current file and line number.
138: #
139: # Exit: Returns nothing. Updates %HITS in place.
140: #
141: # Side effects: Increments %HITS{$norm}{$line}.
142: #
143: # Notes: This sub lives in the DB:: package as
144: # required by Perl's debugger protocol.
145: # It is called for every statement executed
146: # while the debugger is active, so it must
147: # be as fast as possible.
148: # Internal files and out-of-target files
149: # are skipped immediately.
150: # --------------------------------------------------
151: sub DB::DB {
●[NOT COVERED] 152 → 165 → 169●[NOT COVERED] 152 → 165 → 0 152: my (undef, $file, $line) = caller(0);
153:
154: return unless defined $file && defined $line;
155:
156: # Resolve symlinks and relative components to a stable absolute path
157: my $abs = abs_path($file) // $file;
158: my $norm = _normalize($abs);
159:
160: # Never record hits inside this module itself — suffix match is used
161: # so it works regardless of CWD or install prefix
162: return if $norm =~ m{(?:^|/)Devel/App/Test/Generator/LCSAJ/Runtime\.pm$};
163:
164: # If a target list was provided, skip files not in it
165: if(%TARGET) {
Mutants (Total: 1, Killed: 0, Survived: 1)
COND_INV_165_2: Invert condition if to unless MEDIUM: Add tests asserting both true and false outcomes
166: return unless $TARGET{$norm};
167: }
168:
●[NOT COVERED] 169 → 169 → 0 169: $HITS{$norm}{$line}++;
170: }
171:
172: # --------------------------------------------------
173: # _write_results
174: #
175: # Purpose: Serialise %HITS to a per-process JSON
176: # file in the output directory.
177: #
178: # Entry: None. Reads %HITS and $OUT_DIR.
179: #
180: # Exit: Returns nothing. Writes a JSON file.
181: # Returns immediately if %HITS is empty.
182: #
183: # Side effects: Creates $OUT_DIR if absent.
184: # Writes cover_html/lcsaj_hits/hits_PID.json
185: #
186: # Notes: Called from END so it runs even when
187: # prove exits non-zero — mutation tests
188: # are expected to fail. PID is included
189: # in the filename so parallel test runs
190: # produce separate files without collision.
191: # --------------------------------------------------
192: sub _write_results {
193: return unless %HITS;
194:
195: # Include PID in filename to support parallel test runs
196: my $out_file = "$OUT_DIR/hits_$$.json";
197:
198: make_path($OUT_DIR) unless -d $OUT_DIR;
199:
200: open my $fh, '>', $out_file or croak "Cannot write $out_file: $!";
201:
202: print $fh encode_json(\%HITS);
203: close $fh;
204: }
205:
206: 1;
207:
208: __END__
209:
210: =head1 OUTPUT FORMAT
211:
212: C<cover_html/lcsaj_hits/hits_PID.json> is a JSON object of the form:
213:
214: {
215: "lib/Foo/Bar.pm": { "12": 3, "15": 1, ... },
216: ...
217: }
218:
219: Keys are lib-relative paths (C<lib/...>); values are objects mapping line
220: numbers (as strings) to hit counts. One file is written per process so
221: parallel test runs produce separate files.
222:
223: =head1 NOTES ON FILE PLACEMENT
224:
225: The C<-d:App::Test::Generator::LCSAJ::Runtime> flag causes Perl to load
226: C<Devel::App::Test::Generator::LCSAJ::Runtime>, which it finds at:
227:
228: lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm
229:
230: Ensure this path is on C<@INC> (C<-Mblib> or C<-Ilib> in PERL5OPT).
231:
232: =head1 SEE ALSO
233:
234: L<Devel::Cover>, L<App::Test::Generator>
235:
236: =head1 AUTHOR
237:
238: Nigel Horne, C<< <njh at nigelhorne.com> >>
239:
240: Portions of this module's initial design and documentation were created
241: with the assistance of AI.
242:
243: =head1 LICENCE AND COPYRIGHT
244:
245: Copyright 2025-2026 Nigel Horne.
246:
247: Usage is subject to the terms of GPL2.
248: If you use it,
249: please let me know.
250:
251: =cut