view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	my $obj = App::Test::Generator::Sample::Module->new();

	is($obj->mysterious_method(21), 42, 'numeric input is doubled');
	is($obj->mysterious_method(-5), -10, 'negative numeric input is doubled');
	is($obj->mysterious_method(0), 0, 'zero input is doubled to zero');

	# POD explicitly documents that non-numeric input triggers a Perl
	# warning rather than a die -- this is the fixture's intended
	# behaviour (used to test SchemaExtractor's low-confidence heuristic
	# for under-validated methods), so the test asserts a warning is
	# raised and execution continues, not that it dies
	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, $_[0] };
	my $result;
	lives_ok { $result = $obj->mysterious_method('not-a-number') }
		'non-numeric input does not die, per the documented fixture behaviour';
	is($result, 0, q{non-numeric string is treated as 0 by Perl's numeric coercion, doubled to 0});
	ok(scalar(@warnings) > 0, 'non-numeric input triggers at least one Perl warning, as documented');
};

# --------------------------------------------------
# Devel::App::Test::Generator::LCSAJ::Runtime
#
# t/LCSAJ-Runtime.t already covers DB::DB()'s abs_path() memoisation
# and basic hit recording, so these subtests focus on the branches that
# file does not exercise: _normalize() in isolation, the self-exclusion
# guard, the %TARGET allow-list filter, _write_results() (including the
# autodie-disabled open()/croak path fixed in this session), and the
# BEGIN-time LCSAJ_TARGETS env-var parsing, which can only be observed
# by re-loading the module in a fresh child process.
# --------------------------------------------------
subtest 'Devel::App::Test::Generator::LCSAJ::Runtime::_normalize - path canonicalisation' => sub {
	is(
		Devel::App::Test::Generator::LCSAJ::Runtime::_normalize('/home/user/proj/blib/lib/Foo/Bar.pm'),
		'lib/Foo/Bar.pm',
		'a blib/lib/ prefixed path is stripped down to lib/...'
	);
	is(
		Devel::App::Test::Generator::LCSAJ::Runtime::_normalize('/home/user/proj/lib/Foo/Bar.pm'),
		'lib/Foo/Bar.pm',
		'a plain lib/ prefixed path is stripped down to lib/...'
	);
	is(
		Devel::App::Test::Generator::LCSAJ::Runtime::_normalize('lib/Foo/Bar.pm'),
		'lib/Foo/Bar.pm',
		'a path already in lib/... form is left unchanged'
	);
	is(
		Devel::App::Test::Generator::LCSAJ::Runtime::_normalize('/home/user/lib/proj/lib/Foo/Bar.pm'),
		'lib/Foo/Bar.pm',
		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'
	);
};

subtest 'Devel::App::Test::Generator::LCSAJ::Runtime::DB::DB - %TARGET allow-list filtering' => sub {
	local %Devel::App::Test::Generator::LCSAJ::Runtime::HITS = ();
	local %Devel::App::Test::Generator::LCSAJ::Runtime::NORM_CACHE = ();
	local %Devel::App::Test::Generator::LCSAJ::Runtime::TARGET = (
		'lib/SomeOtherModule.pm' => 1,
	);

	DB::DB();

	# DB::DB() resolves $file through abs_path() before normalising, so
	# the cache/comparison key here must be built the same way -- using
	# _normalize(__FILE__) directly (skipping abs_path) would compare a
	# relative path against DB::DB()'s absolute one and never match
	my $this_file = Devel::App::Test::Generator::LCSAJ::Runtime::_normalize(Cwd::abs_path(__FILE__));
	ok(
		!exists $Devel::App::Test::Generator::LCSAJ::Runtime::HITS{$this_file},
		'a populated %TARGET that excludes this file suppresses recording for it'
	);

	%Devel::App::Test::Generator::LCSAJ::Runtime::TARGET = ($this_file => 1);
	my $hit_line = __LINE__ + 1;
	DB::DB();
	is(
		$Devel::App::Test::Generator::LCSAJ::Runtime::HITS{$this_file}{$hit_line},
		1,
		'adding this file to %TARGET allows the next call to record a hit for it'
	);
};

subtest 'Devel::App::Test::Generator::LCSAJ::Runtime::_write_results - skips IO when %HITS is empty' => sub {
	local %Devel::App::Test::Generator::LCSAJ::Runtime::HITS = ();

	my $make_path_calls = 0;
	Test::Mockingbird::mock(
		'Devel::App::Test::Generator::LCSAJ::Runtime',
		'make_path',
		sub { $make_path_calls++; return 1 },
	);
	Devel::App::Test::Generator::LCSAJ::Runtime::_write_results();
	is($make_path_calls, 0, '_write_results() returns immediately, before touching the filesystem, when %HITS is empty');
	Test::Mockingbird::unmock('Devel::App::Test::Generator::LCSAJ::Runtime', 'make_path');
};

subtest 'Devel::App::Test::Generator::LCSAJ::Runtime::_write_results - writes a well-formed per-PID JSON file' => sub {
	my $orig_cwd = getcwd();
	my $tmp = File::Temp::tempdir(CLEANUP => 1);

	local %Devel::App::Test::Generator::LCSAJ::Runtime::HITS = (