view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

};

subtest 'render_args_hash: handles Regexp values' => sub {
	my $result = App::Test::Generator::render_args_hash({ matches => qr/^\d+$/ });
	like($result, qr/qr\{/, 'Regexp rendered as qr{}');
};

subtest 'render_args_hash: handles arrayref values' => sub {
	my $result = App::Test::Generator::render_args_hash({ values => [1, 2, 3] });
	like($result, qr/1.*2.*3/s, 'arrayref values rendered');
};

subtest 'render_hash: matches and nomatch compiled to Regexp' => sub {
	my $result = App::Test::Generator::render_hash({
		param => { type => 'string', matches => '^[a-z]+$' }
	});
	like($result, qr/qr\{/, 'matches pattern compiled to qr{}');
};

subtest 'render_hash: scalar type shorthand expanded' => sub {
	my $result = App::Test::Generator::render_hash({
		name => 'string'
	});
	like($result, qr/type.*string/, 'scalar shorthand expanded to type spec');
};

subtest 'render_arrayref_map: returns empty string for empty hashref' => sub {
	my $result = App::Test::Generator::render_arrayref_map({});
	ok(defined $result, 'empty hashref: returns defined value');
	# Empty hash has no arrayref entries so result is empty string
	is($result, '', 'empty hashref -> empty string');
};

subtest 'render_arrayref_map: returns () for undef input' => sub {
	my $result = App::Test::Generator::render_arrayref_map(undef);
	is($result, '()', 'undef input -> ()');
};

# ==================================================================
# LCSAJ — additional branch path coverage for TER3
# ==================================================================

{
	no warnings 'once';
	*_build_cfg      = \&App::Test::Generator::LCSAJ::_build_cfg;
	*_cfg_to_lcsaj   = \&App::Test::Generator::LCSAJ::_cfg_to_lcsaj;
	*_is_branch      = \&App::Test::Generator::LCSAJ::_is_branch;
	*_new_block      = \&App::Test::Generator::LCSAJ::_new_block;
	*_connect_blocks = \&App::Test::Generator::LCSAJ::_connect_blocks;
}

subtest 'LCSAJ: _build_cfg fallthrough loop connects exactly i to i+1' => sub {
	# Two sequential blocks with no branch — fallthrough must connect [0] to [1]
	require PPI;
	my $src = "sub foo { my \$x = 1; my \$y = 2; return \$x + \$y; }\n";
	my $doc = PPI::Document->new(\$src);
	my $sub = $doc->find_first('PPI::Statement::Sub');
	my $blocks = _build_cfg($sub);
	ok(scalar @{$blocks} >= 1, 'at least one block');
	# For a linear sub the single block should have no edges (it's a leaf)
	# or fallthrough to a next block — verify no crash
	ok(1, '_build_cfg linear sub did not crash');
};

subtest 'LCSAJ: _build_cfg branch creates true and false successor blocks' => sub {
	require PPI;
	my $src = "sub foo { my \$x = shift; if(\$x > 0) { return 1; } return 0; }\n";
	my $doc = PPI::Document->new(\$src);
	my $sub = $doc->find_first('PPI::Statement::Sub');
	my $blocks = _build_cfg($sub);
	# With one if-branch: pre-branch block, true block, false block, post-branch
	ok(scalar @{$blocks} >= 3, 'if-branch creates at least 3 blocks');
	my @with_two_edges = grep { scalar @{$_->{edges}} == 2 } @{$blocks};
	ok(scalar @with_two_edges >= 1, 'at least one block has two edges');
};

subtest 'LCSAJ: _cfg_to_lcsaj target=0 when target block has no lines' => sub {
	# Construct a block that points to an empty block
	my $b1 = _new_block(1);
	push @{$b1->{lines}}, 5;
	push @{$b1->{edges}}, 2;
	my $b2 = _new_block(2);    # empty — no lines
	my $result = _cfg_to_lcsaj([$b1, $b2]);
	is(scalar @{$result}, 1,   'one path produced');
	is($result->[0]{target}, 0, 'target defaults to exactly 0 for empty block');
};

subtest 'LCSAJ: _cfg_to_lcsaj skips leaf blocks with no edges' => sub {
	my $b1 = _new_block(1);
	push @{$b1->{lines}}, 5, 6, 7;
	# No edges — leaf block
	my $result = _cfg_to_lcsaj([$b1]);
	is(scalar @{$result}, 0, 'leaf block with no edges skipped');
};

subtest 'LCSAJ: _cfg_to_lcsaj multiple edges produce separate path records' => sub {
	my $b1 = _new_block(1);
	push @{$b1->{lines}}, 10;
	push @{$b1->{edges}}, 2, 3;
	my $b2 = _new_block(2);
	push @{$b2->{lines}}, 20;
	my $b3 = _new_block(3);
	push @{$b3->{lines}}, 30;
	my $result = _cfg_to_lcsaj([$b1, $b2, $b3]);
	is(scalar @{$result}, 2, 'two edges produce two path records');
	is($result->[0]{start}, 10, 'both paths have same start');
	is($result->[1]{start}, 10, 'both paths have same start');
	isnt($result->[0]{target}, $result->[1]{target}, 'targets differ');
};

subtest 'LCSAJ: unless branch is treated as branch point' => sub {
	require PPI;
	my $src = "sub foo { my \$x = shift; unless(\$x) { return 0; } return 1; }\n";
	my $doc = PPI::Document->new(\$src);
	my $sub = $doc->find_first('PPI::Statement::Sub');
	my $blocks = _build_cfg($sub);
	ok(scalar @{$blocks} >= 2, 'unless branch: at least 2 blocks');
};

subtest 'LCSAJ: while loop is treated as branch point' => sub {
	require PPI;

t/extended_tests.t  view on Meta::CPAN

			$f, { min => 0, max => 1 }
		);
		ok($val >= 0 && $val <= 1,
			"_rand_num($val) within [0, 1]");
	}
};

subtest 'CoverageGuidedFuzzer: _validate_value correctly validates types' => sub {
	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string' } },
		target_sub => sub { 1 },
		iterations => 0,
		seed       => 42,
	);

	# integer
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, 42, { type => 'integer' }), 1, 'integer 42: valid');
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, 3.14, { type => 'integer' }), 0, 'float 3.14: invalid integer');

	# number
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, '3.14', { type => 'number' }), 1, 'string 3.14: valid number');

	# boolean
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, '1', { type => 'boolean' }), 1, '"1": valid boolean');
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, '2', { type => 'boolean' }), 0, '"2": invalid boolean');

	# string with min/max
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, 'hi', { type => 'string', min => 1, max => 10 }), 1, 'string in range: valid');
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, '', { type => 'string', min => 1 }), 0, 'empty string below min: invalid');

	# arrayref
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, [1,2], { type => 'arrayref' }), 1, 'arrayref: valid');
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, 'str', { type => 'arrayref' }), 0, 'string: invalid arrayref');

	# hashref
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, {a=>1}, { type => 'hashref' }), 1, 'hashref: valid');
};

subtest 'CoverageGuidedFuzzer: _validate_value returns 0 for undef' => sub {
	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string' } },
		target_sub => sub { 1 },
		iterations => 0,
		seed       => 42,
	);
	is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
		$f, undef, { type => 'string' }), 0, 'undef: always invalid');
};

# ==================================================================
# Stateful tests — verify state accumulates correctly across calls
# ==================================================================

subtest 'CoverageGuidedFuzzer: corpus accumulates across multiple run() calls' => sub {
	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string' } },
		target_sub => sub { length($_[0] // '') },
		iterations => 5,
		seed       => 42,
	);
	$f->run();
	my $size1 = scalar @{$f->corpus()};
	$f->run();
	my $size2 = scalar @{$f->corpus()};
	ok($size2 >= $size1, 'corpus grows or stays same across runs');
};

subtest 'CoverageGuidedFuzzer: stats accumulate across run() calls' => sub {
	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string' } },
		target_sub => sub { 1 },
		iterations => 5,
		seed       => 42,
	);
	my $r1 = $f->run();
	my $r2 = $f->run();
	ok($r2->{total_iterations} >= $r1->{total_iterations},
		'total_iterations increases across runs');
};

subtest 'Mutator: generate_mutants is idempotent — same results on two calls' => sub {
	my $tmpdir = tempdir(CLEANUP => 1);
	my $lib    = File::Spec->catdir($tmpdir, 'lib');
	mkdir $lib or die $!;
	my $pm = File::Spec->catfile($lib, 'Idempotent.pm');
	open my $fh, '>', $pm or die $!;
	print $fh "package Idempotent;\nsub foo { if(\$x > 0) { return 1; } return 0; }\n1;\n";
	close $fh;

	my $mutator = App::Test::Generator::Mutator->new(
		file    => $pm,
		lib_dir => $lib,
	);
	my @m1 = $mutator->generate_mutants();
	my @m2 = $mutator->generate_mutants();
	is(scalar @m1, scalar @m2, 'generate_mutants count is idempotent');
};

subtest 'Planner: plan_all is idempotent — same results on two calls' => sub {
	my $p = App::Test::Generator::Planner->new(
		schemas => {
			foo => { accessor => { type => 'get' }, output => {} },
			bar => { output => { type => 'boolean' } },
		},
		package => 'Foo',
	);
	my $plan1 = $p->plan_all();
	my $plan2 = $p->plan_all();
	is_deeply($plan1, $plan2, 'plan_all is idempotent');
};