view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

# t/Analyzer-SideEffect.t already has a dedicated subtest proving
# performs_io/calls_external ignore keywords inside string literals
# and comments. mutates_self and mutates_globals had no equivalent
# protection: they matched against the raw $body instead of the
# string/comment-stripped $code_only, so a docstring merely
# mentioning "$self->{name} = ..." or "%ENV" falsely set those flags.
# This was a real bug (verified to misfire before the fix), not just
# a documentation gap, and has been corrected in the production code
# to match the same $code_only convention IO_PATTERN/EXEC_PATTERN
# already used.
# ==================================================================
subtest 'Analyzer::SideEffect::analyze - mutates_self ignores field-assignment text inside a string literal' => sub {
	require App::Test::Generator::Analyzer::SideEffect;
	my $analyser = App::Test::Generator::Analyzer::SideEffect->new;

	my $report = $analyser->analyze({
		body => q{sub foo { return "use $self->{name} = x in docs"; }},
	});
	is($report->{mutates_self}, 0,
		'field-assignment text inside a string literal does not set mutates_self');
	is_deeply($report->{mutation_fields}, [],
		'no mutation_fields captured from the string literal');

	done_testing();
};

subtest 'Analyzer::SideEffect::analyze - mutates_globals ignores global-variable text inside a string literal' => sub {
	require App::Test::Generator::Analyzer::SideEffect;
	my $analyser = App::Test::Generator::Analyzer::SideEffect->new;

	my $report = $analyser->analyze({
		body => q{sub foo { return "Set %ENV manually"; }},
	});
	is($report->{mutates_globals}, 0,
		'global-variable text inside a string literal does not set mutates_globals');

	done_testing();
};

# ==================================================================
# App::Test::Generator::CoverageGuidedFuzzer
#
# t/CoverageGuided_Fuzzer_unit.t already exhaustively covers new(),
# run(), corpus(), bugs(), save_corpus(), and load_corpus() against
# their documented API. The one POD-documented behaviour with no
# existing regression coverage is run()'s bug-filtering rule: a
# target_sub die is only recorded in bugs() when the input that
# triggered it is schema-valid (see run()'s POD Notes, added this
# session). Verify both halves of that rule with a deterministic
# seed: a target that always dies, fed integers constrained to
# [100,200], must record only in-range inputs as bugs even though
# some generated inputs (the int-boundary bias picks 0/-1/1) fall
# outside that range and are correctly discarded as expected failures.
# ==================================================================
subtest 'CoverageGuidedFuzzer::run - only records bugs for schema-valid input' => sub {
	require App::Test::Generator::CoverageGuidedFuzzer;

	my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'integer', min => 100, max => 200 } },
		target_sub => sub { die "boom\n" },
		iterations => 30,
		seed       => 42,
	);
	$fuzzer->run();

	my @bugs = @{ $fuzzer->bugs() };
	ok(scalar(@bugs) > 0, 'at least one in-range die was recorded as a bug');
	ok(scalar(@bugs) < 30,
		'at least one out-of-range die was correctly NOT recorded as a bug');
	ok((!grep { $_->{input} < 100 || $_->{input} > 200 } @bugs),
		'every recorded bug input falls within the schema-declared min/max');

	done_testing();
};

# ==================================================================
# App::Test::Generator::Emitter::Perl
#
# TestStrategy.pm sets $plan{boundary_tests} when a method's schema
# carries non-empty _yamltest_hints, but _emit_method_tests() had no
# dispatch branch for that flag at all -- a $TEST_BOUNDARY constant
# was defined but never read. Methods planned for boundary testing
# silently got zero generated test code for it. Fixed by adding the
# dispatch line plus a new _emit_boundary_test() that emits one
# smoke-test block per boundary_values/invalid_inputs hint value.
# ==================================================================
subtest 'Emitter::Perl::emit - boundary_tests flag emits one block per hint value' => sub {
	require App::Test::Generator::Emitter::Perl;

	my $emitter = App::Test::Generator::Emitter::Perl->new(
		schema => {
			clamp => {
				_yamltest_hints => {
					boundary_values => [0, 255],
					invalid_inputs  => [-1],
				},
			},
		},
		plans   => { clamp => { boundary_tests => 1 } },
		package => 'My::Module',
	);
	my $code = $emitter->emit;

	like($code, qr/\$obj->clamp\(0\)/, 'boundary value 0 emitted');
	like($code, qr/\$obj->clamp\(255\)/, 'boundary value 255 emitted');
	like($code, qr/\$obj->clamp\(-1\)/, 'invalid_inputs value -1 emitted');

	done_testing();
};

subtest 'Emitter::Perl::emit - boundary_tests flag with no hint values emits nothing' => sub {
	require App::Test::Generator::Emitter::Perl;

	my $emitter = App::Test::Generator::Emitter::Perl->new(
		schema  => { clamp => { _yamltest_hints => {} } },
		plans   => { clamp => { boundary_tests => 1 } },
		package => 'My::Module',
	);
	my $code = $emitter->emit;

	unlike($code, qr/survives boundary input/,