File Coverage

File:blib/lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm
Coverage:85.1%

linestmtbrancondsubtimecode
1package Devel::App::Test::Generator::LCSAJ::Runtime;
2
3
2
2
2
2
65414
1
23
use strict;
4
2
2
2
2
4
2
59
use warnings;
5
2
2
2
2
167
5949
4
use autodie     qw(open close);
6
2
2
2
2
362
1
37
use Carp        qw(croak);
7
2
2
2
2
6
2
32
use Cwd         qw(abs_path);
8
2
2
2
2
3
1
39
use JSON::MaybeXS;
9
2
2
2
2
2
2
31
use File::Path  qw(make_path);
10
2
2
2
2
252
1692
207
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# --------------------------------------------------
17Readonly my $OUT_DIR => 'cover_html/lcsaj_hits';
18
19 - 29
=head1 NAME

Devel::App::Test::Generator::LCSAJ::Runtime - Debugger backend for LCSAJ coverage

=encoding UTF-8

=head1 VERSION

Version 0.41

=cut
30
31our $VERSION = '0.41';
32
33 - 64
=head1 SYNOPSIS

  PERL5OPT='-d:App::Test::Generator::LCSAJ::Runtime -Mblib' prove -l t

=head1 DESCRIPTION

This module is loaded as a Perl debugger backend using the C<-d:Module> flag.

When Perl sees C<-d:App::Test::Generator::LCSAJ::Runtime> it prepends C<Devel::>
and loads C<Devel/App/Test/Generator/LCSAJ/Runtime.pm> from C<@INC>.
The file must therefore live at that path - typically C<lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm>.

Perl automatically calls C<DB::DB> before executing each statement while the
debugger is active. We record (file, line) pairs to build runtime hit data for
later LCSAJ analysis.

Results are written to C<cover_html/lcsaj_hits/hits_PID.json> at process exit,
one file per process so that parallel test runs do not overwrite each other.

=head1 ENVIRONMENT

=over 4

=item LCSAJ_TARGETS

Optional colon-separated list of B<absolute> paths (as produced by C<realpath>)
to restrict recording to specific source files. When empty or unset every
non-internal file is recorded.

=back

=cut
65
66# --------------------------------------------------
67# %HITS       - { normalised_path => { line_number => hit_count } }
68# %TARGET     - set of normalised paths to record (empty means record everything)
69# %NORM_CACHE - { raw_file => normalised_path }, memoises abs_path()
70#               since DB::DB sees the same $file on every consecutive
71#               statement within a source file
72#
73# These must be package globals (our) rather than lexicals because DB::DB
74# is called by the Perl debugger infrastructure and needs to access them
75# without a closure. Lexical vars would not be visible in DB::DB.
76# --------------------------------------------------
77our %HITS;
78our %TARGET;
79our %NORM_CACHE;
80
81# --------------------------------------------------
82# Populate %TARGET from LCSAJ_TARGETS at compile time.
83# The env var contains absolute realpath() output
84# separated by colons. Stray newlines from broken
85# shell pipelines are stripped defensively.
86# --------------------------------------------------
87BEGIN {
88
2
50
2
7
        my $targets_env = $ENV{LCSAJ_TARGETS} // '';
89
2
2
        $targets_env =~ s/\n//g;
90
91
2
316
        for my $t (split /:/, $targets_env) {
92
0
0
0
                next unless length $t;
93
94                # Inline normalisation — cannot call _normalize here since
95                # BEGIN runs before named subs are compiled when BEGIN
96                # appears at the top of the file
97
0
0
                my $f = $t;
98
0
0
                $f =~ s{^.*/blib/lib/}{lib/};
99
0
0
                $f =~ s{^.*/lib/}{lib/};
100
0
0
                $TARGET{$f} = 1;
101        }
102}
103
104END {
105
2
2
3042
        _write_results();
106}
107
108# --------------------------------------------------
109# _normalize
110#
111# Purpose:    Convert an absolute or build-tree path
112#             to a canonical lib-relative form so that
113#             paths recorded at runtime match the
114#             targets derived from LCSAJ_TARGETS.
115#
116# Entry:      $path - an absolute or relative file path.
117#
118# Exit:       Returns a lib-relative path string,
119#             e.g. lib/Foo/Bar.pm
120#
121# Side effects: None.
122#
123# Notes:      Must be defined before the BEGIN block
124#             that calls it, since BEGIN runs at compile
125#             time and later subs may not yet be compiled.
126#
127# Examples:
128#   /home/user/proj/blib/lib/Foo/Bar.pm  ->  lib/Foo/Bar.pm
129#   /home/user/proj/lib/Foo/Bar.pm       ->  lib/Foo/Bar.pm
130# --------------------------------------------------
131sub _normalize {
132
8
8
1312
        my $f = $_[0];
133
134        # Strip everything up to and including blib/lib/ or lib/
135
8
13
        $f =~ s{^.*/blib/lib/}{lib/};
136
8
14
        $f =~ s{^.*/lib/}{lib/};
137
8
11
        return $f;
138}
139
140# --------------------------------------------------
141# DB::DB
142#
143# Purpose:    Called by the Perl debugger before every
144#             statement. Records (file, line) hits for
145#             later LCSAJ coverage analysis.
146#
147# Entry:      No arguments — caller(0) is used to get
148#             the current file and line number.
149#
150# Exit:       Returns nothing. Updates %HITS in place.
151#
152# Side effects: Increments %HITS{$norm}{$line}.
153#
154# Notes:      This sub lives in the DB:: package as
155#             required by Perl's debugger protocol.
156#             It is called for every statement executed
157#             while the debugger is active, so it must
158#             be as fast as possible.
159#             Internal files and out-of-target files
160#             are skipped immediately.
161#             abs_path() resolution is memoised in
162#             %NORM_CACHE per raw $file, since the same
163#             file is seen on every consecutive statement.
164# --------------------------------------------------
165 - 221
=head2 DB::DB

Perl debugger hook, automatically invoked by the interpreter before every
statement while this module is active as a C<-d:> debugger backend.
Records a per-(file, line) hit count used later for LCSAJ coverage
analysis.

=head3 Arguments

None. Perl calls this sub directly; the current execution location is
obtained internally via C<caller(0)>.

=head3 Returns

Nothing meaningful — this is a void debugger callback.

=head3 Side effects

Increments C<%HITS{$norm}{$line}> for the normalised path and line number
of the statement about to execute. Resolves each distinct raw filename
via C<Cwd::abs_path> once, memoising the result in C<%NORM_CACHE>.

=head3 Usage example

Not called directly — activated via the Perl debugger flag:

    PERL5OPT='-d:App::Test::Generator::LCSAJ::Runtime -Mblib' prove -l t

=head3 API specification

=head4 input

    { }

=head4 output

    { type => UNDEF }

=head3 Formal specification

Let H be the hits relation (file x line) → ℕ, T be the target-file set,
and I be the internal-file predicate (true only for this module's own
source path).

  â”Œ DB_DB ──────────────────────────────────────────
  â”‚ ΔH
  â”‚ file? : FilePath
  â”‚ line? : â„•
  â”œâ”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€
  â”‚ norm == normalize(file?)
  â”‚ ¬I(norm) ∧ (T = ∅ ∨ norm ∈ T)
  â”‚   âŸ¹ H′(norm, line?) = H(norm, line?) + 1
  â”‚ I(norm) ∨ (T ≠ ∅ ∧ norm ∉ T)
  â”‚   âŸ¹ H′ = H
  â””─────────────────────────────────────────────────

=cut
222
223sub DB::DB {
224
7
7
83989
        my (undef, $file, $line) = caller(0);
225
226
7
50
33
60
        return unless defined $file && defined $line;
227
228        # Resolve symlinks and relative components to a stable absolute path,
229        # cached per raw $file to avoid a stat() on every statement
230
7
67
33
23
        my $norm = $NORM_CACHE{$file} //= _normalize(abs_path($file) // $file);
231
232        # Never record hits inside this module itself — suffix match is used
233        # so it works regardless of CWD or install prefix
234
7
100
16
        return if $norm =~ m{(?:^|/)Devel/App/Test/Generator/LCSAJ/Runtime\.pm$};
235
236        # If a target list was provided, skip files not in it
237
6
100
6
        if(%TARGET) {
238
2
100
3
                return unless $TARGET{$norm};
239        }
240
241
5
10
        $HITS{$norm}{$line}++;
242}
243
244# --------------------------------------------------
245# _write_results
246#
247# Purpose:    Serialise %HITS to a per-process JSON
248#             file in the output directory.
249#
250# Entry:      None. Reads %HITS and $OUT_DIR.
251#
252# Exit:       Returns nothing. Writes a JSON file.
253#             Returns immediately if %HITS is empty.
254#
255# Side effects: Creates $OUT_DIR if absent.
256#               Writes cover_html/lcsaj_hits/hits_PID.json
257#
258# Notes:      Called from END so it runs even when
259#             prove exits non-zero — mutation tests
260#             are expected to fail. PID is included
261#             in the filename so parallel test runs
262#             produce separate files without collision.
263# --------------------------------------------------
264sub _write_results {
265
5
100
5
5911
        return unless %HITS;
266
267        # Include PID in filename to support parallel test runs
268
2
6
        my $out_file = "$OUT_DIR/hits_$$.json";
269
270
2
100
7
        make_path($OUT_DIR) unless -d $OUT_DIR;
271
272        # autodie is disabled for this open -- under "use autodie qw(open)"
273        # open() never returns false on failure, it throws its own exception
274        # instead, which would silently make the "or croak" below dead code
275
2
2
2
2
6
2
4
        no autodie qw(open);
276
2
100
220
        open my $fh, '>', $out_file or croak "Cannot write $out_file: $!";
277
278
1
8
        print $fh encode_json(\%HITS);
279
1
4
        close $fh;
280}
281
2821;
283