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,

t/integration.t  view on Meta::CPAN

package Sample::Branchy;
use strict;
use warnings;
sub classify {
	my ($self, $n) = @_;
	if($n > 0) { return 'positive'; }
	if($n < 0) { return 'negative'; }
	return 'zero';
}
1;
END_PM
	close $fh_b;

	require Cwd;
	my $orig = Cwd::cwd();

	chdir $tmpdir_a or die $!;
	my $mutator_a = App::Test::Generator::Mutator->new(
		file => File::Spec->catfile('lib', 'Sample', 'Calculator.pm'), lib_dir => 'lib',
	);
	my @mutants_a_pass1 = eval { $mutator_a->generate_mutants() };
	chdir $orig;

	chdir $tmpdir_b or die $!;
	my $mutator_b = App::Test::Generator::Mutator->new(
		file => File::Spec->catfile('lib', 'Sample', 'Branchy.pm'), lib_dir => 'lib',
	);
	my @mutants_b = eval { $mutator_b->generate_mutants() };
	chdir $orig;

	# Re-run mutator_a after mutator_b has been constructed and used,
	# to confirm mutator_a's own results are unaffected by mutator_b.
	chdir $tmpdir_a or die $!;
	my @mutants_a_pass2 = eval { $mutator_a->generate_mutants() };
	chdir $orig;

	ok(scalar @mutants_a_pass1 > 0, 'mutator_a produced mutants');
	ok(scalar @mutants_b > 0,       'mutator_b produced mutants');
	is(scalar @mutants_a_pass1, scalar @mutants_a_pass2,
		'mutator_a is deterministic and unaffected by mutator_b running in between');

	for my $m (@mutants_a_pass1) {
		unlike($m->line_content // '', qr/classify|positive|negative/,
			"mutator_a mutant does not reference mutator_b's source");
	}
	for my $m (@mutants_b) {
		unlike($m->line_content // '', qr/precision|Calculator/,
			"mutator_b mutant does not reference mutator_a's source");
	}
};

subtest 'Concurrency: independent CoverageGuidedFuzzer instances do not share corpus or bug state' => sub {
	my $calls_a = 0;
	my $target_a = sub { $calls_a++; die "A trigger\n" if ($_[0] // '') eq 'A_BUG'; return 1; };

	my $calls_b = 0;
	my $target_b = sub { $calls_b++; die "B trigger\n" if ($_[0] // '') eq 'B_BUG'; return 1; };

	my $f_a = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema => { input => { type => 'string', min => 1, max => 10 } },
		target_sub => $target_a, iterations => $FUZZ_SMALL_ITER, seed => $FUZZ_SEED_A,
	);
	my $f_b = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema => { input => { type => 'string', min => 1, max => 10 } },
		target_sub => $target_b, iterations => $FUZZ_SMALL_ITER, seed => $FUZZ_SEED_B,
	);

	if($ENV{EXTENDED_TESTING}) {
		# Interleave: run A, then B, then A again, so any shared
		# package-level state would show up as cross-contamination.
		# total_iterations accumulates per-instance across run() calls
		# (stats live in $self, initialised once in new()), so fuzzer
		# A's second run is expected to report 2x iterations — what
		# matters for this test is that fuzzer B's run in between adds
		# nothing to fuzzer A's count.
		my $r_a1 = $f_a->run();
		my $r_b  = $f_b->run();
		my $r_a2 = $f_a->run();

		is($r_a1->{total_iterations}, $FUZZ_SMALL_ITER,     'fuzzer A first run completed its own iteration count');
		is($r_b->{total_iterations},  $FUZZ_SMALL_ITER,     'fuzzer B run completed its own iteration count');
		is($r_a2->{total_iterations}, $FUZZ_SMALL_ITER * 2, 'fuzzer A accumulates only its own iterations, unaffected by fuzzer B running between');
		ok($calls_a > 0, 'target_a was actually called by fuzzer A');
		ok($calls_b > 0, 'target_b was actually called by fuzzer B');

		for my $bug (@{ $f_a->bugs() }) {
			unlike($bug->{error} // '', qr/B trigger/, 'fuzzer A bug list never contains fuzzer B errors');
		}
		for my $bug (@{ $f_b->bugs() }) {
			unlike($bug->{error} // '', qr/A trigger/, 'fuzzer B bug list never contains fuzzer A errors');
		}
	} else {
		ok(1, 'EXTENDED_TESTING not set — skipping fuzzer run, construction only');
	}
};

# ==================================================================
# PIPELINE 14: Optional dependency fallback — BSD::Resource missing
#
# CLAUDE.md documents BSD::Resource as loaded via a runtime require
# inside SchemaExtractor's _compile_signature_isolated (not a
# Makefile.PL PREREQ_PM, Unix-only, best-effort rlimit). This pipeline
# proves the documented fallback: extraction must succeed identically
# whether or not the module is installed.
# ==================================================================

subtest 'SchemaExtractor: signature_for extraction degrades gracefully without BSD::Resource' => sub {
	# The fixture module below is only ever compiled by the isolated
	# perl -T subprocess spawned from _compile_signature_isolated()
	# (PIPELINE 14 sets allow_signature_exec => 1), so the dependency
	# on Type::Params/Types::Common is real, not just text inside this
	# process. Test::Without::Module cannot simulate "missing" for it
	# (its @INC hook does not propagate to the spawned subprocess), so
	# unlike BSD::Resource below, this is a hard skip, not a fallback
	# under test.
	test_needs('Type::Params', 'Types::Common');

	my $module_src = <<'END_MODULE';
package TestModule::SignatureFor;
use Types::Standard qw(Num);
use Type::Params qw(-sigs);

signature_for add_numbers => (
	method     => 1,
	positional => [ Num, Num ],
	returns    => Num,
);

sub add_numbers ( $self, $first, $second ) {
	return $first + $second;
}
1;
END_MODULE

	my $tmpdir = tempdir(CLEANUP => 1);
	my $module_file = File::Spec->catfile($tmpdir, 'SignatureFor.pm');
	open my $fh, '>', $module_file or die $!;
	print $fh $module_src;
	close $fh;

	my $extract_with = sub {
		my $extractor = App::Test::Generator::SchemaExtractor->new(