view release on metacpan or  search on metacpan

lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm  view on Meta::CPAN

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

sub DB::DB {
	my (undef, $file, $line) = caller(0);

	return unless defined $file && defined $line;

	# Resolve symlinks and relative components to a stable absolute path,
	# cached per raw $file to avoid a stat() on every statement
	my $norm = $NORM_CACHE{$file} //= _normalize(abs_path($file) // $file);

	# Never record hits inside this module itself — suffix match is used
	# so it works regardless of CWD or install prefix
	return if $norm =~ m{(?:^|/)Devel/App/Test/Generator/LCSAJ/Runtime\.pm$};

	# If a target list was provided, skip files not in it
	if(%TARGET) {
		return unless $TARGET{$norm};
	}

	$HITS{$norm}{$line}++;
}

# --------------------------------------------------
# _write_results
#
# Purpose:    Serialise %HITS to a per-process JSON
#             file in the output directory.
#
# Entry:      None. Reads %HITS and $OUT_DIR.
#
# Exit:       Returns nothing. Writes a JSON file.
#             Returns immediately if %HITS is empty.
#
# Side effects: Creates $OUT_DIR if absent.
#               Writes cover_html/lcsaj_hits/hits_PID.json
#
# Notes:      Called from END so it runs even when
#             prove exits non-zero — mutation tests
#             are expected to fail. PID is included
#             in the filename so parallel test runs
#             produce separate files without collision.
# --------------------------------------------------
sub _write_results {
	return unless %HITS;

	# Include PID in filename to support parallel test runs
	my $out_file = "$OUT_DIR/hits_$$.json";

	make_path($OUT_DIR) unless -d $OUT_DIR;

	# autodie is disabled for this open -- under "use autodie qw(open)"
	# open() never returns false on failure, it throws its own exception
	# instead, which would silently make the "or croak" below dead code
	no autodie qw(open);
	open my $fh, '>', $out_file or croak "Cannot write $out_file: $!";

	print $fh encode_json(\%HITS);
	close $fh;
}

1;

__END__

=head1 OUTPUT FORMAT

C<cover_html/lcsaj_hits/hits_PID.json> is a JSON object of the form: