App-Test-Generator

 view release on metacpan or  search on metacpan

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

	return $f;
}

# --------------------------------------------------
# DB::DB
#
# Purpose:    Called by the Perl debugger before every
#             statement. Records (file, line) hits for
#             later LCSAJ coverage analysis.
#
# Entry:      No arguments — caller(0) is used to get
#             the current file and line number.
#
# Exit:       Returns nothing. Updates %HITS in place.
#
# Side effects: Increments %HITS{$norm}{$line}.
#
# Notes:      This sub lives in the DB:: package as
#             required by Perl's debugger protocol.
#             It is called for every statement executed
#             while the debugger is active, so it must

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

=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>.

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

  │ 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$};

t/LCSAJ-Runtime.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use Test::Most;
use Test::Mockingbird;

# Unit tests for Devel::App::Test::Generator::LCSAJ::Runtime's DB::DB hook.
#
# DB::DB is normally invoked by the Perl debugger before every statement,
# but caller(0) works identically when called directly from ordinary code,
# so it can be exercised without actually running under -d:Module.

BEGIN { require Devel::App::Test::Generator::LCSAJ::Runtime; }

my $abs_path_calls = 0;
Test::Mockingbird::mock(
	'Devel::App::Test::Generator::LCSAJ::Runtime',
	'abs_path',
	sub { $abs_path_calls++; return $_[0] },
);

t/function.t  view on Meta::CPAN

		q{a path containing "lib/" more than once is stripped at the rightmost (greediest) occurrence}
	);
};

subtest 'Devel::App::Test::Generator::LCSAJ::Runtime::DB::DB - self-exclusion guard' => sub {
	local %Devel::App::Test::Generator::LCSAJ::Runtime::HITS = ();
	local %Devel::App::Test::Generator::LCSAJ::Runtime::NORM_CACHE = (
		'FAKE_RUNTIME_CALLER' => 'lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm',
	);

	# A #line directive lets us make caller(0) report an arbitrary
	# filename from inside eval'd code, without needing a second real
	# file on disk -- the cached normalised path is what the exclusion
	# regex actually matches against
	eval qq{#line 1 "FAKE_RUNTIME_CALLER"\nDB::DB();};
	is($@, '', 'DB::DB() does not die when called against its own normalised path') or diag($@);

	ok(
		!exists $Devel::App::Test::Generator::LCSAJ::Runtime::HITS{'lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm'},
		'DB::DB() never records a hit against its own module path'
	);