view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

sub foo {
	my $x = shift;
	my $y = $x + 1;
	return $y;
}
1;
END

	my $branching_src = <<'END';
package Branching;
sub foo {
	my $x = shift;
	if($x > 0) { return $x; }
	if($x < 0) { return -$x; }
	return 0;
}
1;
END

	my $tmpdir = tempdir(CLEANUP => 1);
	require Cwd;
	my $orig = Cwd::cwd();
	chdir $tmpdir or die $!;

	open my $fh1, '>', 'Linear.pm' or die $!;
	print $fh1 $linear_src;
	close $fh1;

	open my $fh2, '>', 'Branching.pm' or die $!;
	print $fh2 $branching_src;
	close $fh2;

	my $lin_paths = App::Test::Generator::LCSAJ->generate('Linear.pm',   'lin_out');
	my $br_paths  = App::Test::Generator::LCSAJ->generate('Branching.pm', 'br_out');
	chdir $orig;

	ok(scalar @{$br_paths} > scalar @{$lin_paths},
		'branching code produces more LCSAJ paths than linear code');
};

# ==================================================================
# PIPELINE 5: CoverageGuidedFuzzer -> corpus round-trip
# ==================================================================

subtest 'CoverageGuidedFuzzer: run -> save_corpus -> load_corpus -> run' => sub {
	my $tmpdir      = tempdir(CLEANUP => 1);
	my $corpus_file = File::Spec->catfile($tmpdir, 'corpus.json');

	my $call_count = 0;
	my $target = sub {
		my $input = shift;
		$call_count++;
		die "too long\n" if defined($input) && length($input) > 50;
		return length($input // '');
	};

	# First run
	my $f1 = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string', max => 100 } },
		target_sub => $target,
		iterations => 10,
		seed       => 42,
	);
	if($ENV{EXTENDED_TESTING}) {
		my $r1 = $f1->run();
		is($r1->{total_iterations}, 10, 'first run: 10 iterations completed');
	}

	# Save corpus
	lives_ok(sub { $f1->save_corpus($corpus_file) },
		'save_corpus() lives after run');
	ok(-f $corpus_file, 'corpus file written');

	# Load into second fuzzer
	my $f2 = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string', max => 100 } },
		target_sub => $target,
		iterations => 5,
		seed       => 99,
	);
	# Second run
	if($ENV{EXTENDED_TESTING}) {
		lives_ok(sub { $f2->load_corpus($corpus_file) }, 'load_corpus() lives');
		ok(scalar @{$f2->corpus()} > 0, 'corpus loaded into second fuzzer');

		my $r2 = $f2->run();
		is($r2->{total_iterations}, 5, 'second run: 5 iterations completed');
		ok($call_count > 0, 'target sub called across both runs');
	}
};

subtest 'CoverageGuidedFuzzer: bugs list entries are well-formed' => sub {
	my $target = sub {
		my $input = shift;
		die "trigger\n" if defined($input) && $input eq 'TRIGGER';
		return 1;
	};

	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string', min => 1, max => 20 } },
		target_sub => $target,
		iterations => 30,
		seed       => 42,
	);

	if($ENV{EXTENDED_TESTING}) {
		lives_ok(sub { $f->run() }, 'run() lives');
	}

	for my $bug (@{$f->bugs()}) {
		ok(exists $bug->{input}, 'bug entry has input key');
		ok(exists $bug->{error}, 'bug entry has error key');
		ok(defined $bug->{error}, 'bug error is defined');
	}
	ok(1, 'bug list iteration completed');
};

# ==================================================================
# PIPELINE 6: Generator with various schema configurations
# ==================================================================

subtest 'Generator: integer input/output schema produces compilable test' => sub {
	my $schema  = _make_schema(function => 'add', input => 'integer', output => 'integer');
	my $tmpdir  = tempdir(CLEANUP => 1);
	my $outfile = File::Spec->catfile($tmpdir, 'add.t');
	capture(sub { App::Test::Generator->generate($schema, $outfile) });
	ok(-f $outfile, 'test file written for integer schema');
	is(system($^X, '-c', $outfile), 0, 'generated test compiles');
};

subtest 'Generator: boolean output schema produces compilable test' => sub {
	my $schema  = _make_schema(function => 'is_positive', input => 'number', output => 'boolean');
	my $tmpdir  = tempdir(CLEANUP => 1);
	my $outfile = File::Spec->catfile($tmpdir, 'bool.t');
	capture(sub { App::Test::Generator->generate($schema, $outfile) });
	ok(-f $outfile, 'test file written for boolean schema');
	is(system($^X, '-c', $outfile), 0, 'generated test compiles');
};

subtest 'Generator: same seed produces reproducible output' => sub {
	my $s1 = _make_schema(function => 'my_func', input => 'string',
		output => 'string', extra => 'seed: 12345');
	my $s2 = _make_schema(function => 'my_func', input => 'string',
		output => 'string', extra => 'seed: 12345');
	my ($out1) = capture(sub { App::Test::Generator->generate($s1) });
	my ($out2) = capture(sub { App::Test::Generator->generate($s2) });
	is($out1, $out2, 'same seed produces identical output');
};

subtest 'Generator: different seeds produce different output' => sub {
	my $s1 = _make_schema(function => 'my_func', input => 'string',
		output => 'string', extra => 'seed: 1');
	my $s2 = _make_schema(function => 'my_func', input => 'string',
		output => 'string', extra => 'seed: 2');
	my ($out1) = capture(sub { App::Test::Generator->generate($s1) });
	my ($out2) = capture(sub { App::Test::Generator->generate($s2) });
	isnt($out1, $out2, 'different seeds produce different output');
};

subtest 'Generator: iterations config controls iteration count in output' => sub {
	my $schema = _make_schema(function => 'my_func', input => 'string',
		output => 'string', extra => 'iterations: 99');
	my ($out) = capture(sub { App::Test::Generator->generate($schema) });
	like($out, qr/99/, 'iteration count 99 appears in generated output');
};

# ==================================================================
# PIPELINE 7: SchemaExtractor strict_pod validation report
# ==================================================================

subtest 'SchemaExtractor: strict_pod=1 populates validation report' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	my $extractor = App::Test::Generator::SchemaExtractor->new(
		input_file => $pm,
		strict_pod => 1,
	);
	my $schemas = $extractor->extract_all(no_write => 1);
	my $report  = $extractor->generate_pod_validation_report($schemas);

	ok(defined $report,     'report is defined');
	ok(length($report) > 0, 'report is non-empty');
	ok(
		$report =~ /All methods passed/i || $report =~ /Validation Report/i,
		'report is either all-passed or a validation report',
	);
};

subtest 'SchemaExtractor -> generate_pod_validation_report: injected errors appear' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	my $extractor = App::Test::Generator::SchemaExtractor->new(
		input_file => $pm,
	);
	my $schemas = $extractor->extract_all(no_write => 1);

	# Inject errors into two methods that we know were extracted
	my @methods = sort keys %{$schemas};
	SKIP: {
		skip 'fewer than two methods extracted', 1 unless scalar @methods >= 2;
		my ($m1, $m2) = @methods[0, 1];
		$schemas->{$m1}{_pod_validation_errors} = ['param mismatch'];
		$schemas->{$m1}{_pod_disagreement}      = 1;
		$schemas->{$m2}{_pod_validation_errors} = ['return type unclear'];
		$schemas->{$m2}{_pod_disagreement}      = 1;

		my $report = $extractor->generate_pod_validation_report($schemas);
		like($report, qr/\Q$m1\E/, "$m1 appears in report");
		like($report, qr/\Q$m2\E/, "$m2 appears in report");
	}
};

# ==================================================================
# PIPELINE 8: Full stack — SchemaExtractor write -> Generator read
# ==================================================================

subtest 'Full stack: SchemaExtractor write -> Generator read round-trip' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	my $out_dir = File::Spec->catdir($tmpdir, 'schemas');
	mkdir $out_dir or die $!;

	my $extractor = App::Test::Generator::SchemaExtractor->new(
		input_file => $pm,
		output_dir => $out_dir,