App-Test-Generator

 view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use Test::Most;
use Capture::Tiny qw(capture);
use File::Path    qw(make_path);
use File::Temp    qw(tempdir tempfile);
use File::Spec;
use YAML::XS      qw(LoadFile);

# Integration tests for App::Test::Generator.
# Each subtest exercises end-to-end behaviour across multiple modules,
# verifying that they compose correctly and that state flows through
# the pipeline as documented.

BEGIN {
	use_ok('App::Test::Generator');
	use_ok('App::Test::Generator::SchemaExtractor');
	use_ok('App::Test::Generator::Planner');
	use_ok('App::Test::Generator::Emitter::Perl');
	use_ok('App::Test::Generator::Mutator');
	use_ok('App::Test::Generator::LCSAJ');
	use_ok('App::Test::Generator::CoverageGuidedFuzzer');
}

# --------------------------------------------------
# Shared sample Perl module source used across tests
# --------------------------------------------------
my $SAMPLE_MODULE = <<'END_PM';
package Sample::Calculator;

use strict;
use warnings;

=head2 new

Construct a Calculator.

=cut

sub new {
	my ($class, %args) = @_;
	return bless { precision => $args{precision} // 2 }, $class;
}

=head2 add

Add two numbers.

=head3 Arguments

=over 4

=item * C<$a> - first number

=item * C<$b> - second number

=back

=head3 Returns

The sum of $a and $b.

=cut

sub add {
	my ($self, $a, $b) = @_;
	die "Arguments required" unless defined $a && defined $b;
	return $a + $b;
}

=head2 is_positive

t/integration.t  view on Meta::CPAN

	$self->{precision} = $val if defined $val;
	return $self->{precision};
}

1;
END_PM

# --------------------------------------------------
# Helper: write $SAMPLE_MODULE to a temp lib dir.
# Returns ($pm, $tmpdir) where $pm is the absolute
# path to the written .pm file.
# --------------------------------------------------
sub _make_sample_module {
	my $tmpdir = tempdir(CLEANUP => 1);
	my $lib    = File::Spec->catdir($tmpdir, 'lib', 'Sample');
	make_path($lib);
	my $pm = File::Spec->catfile($lib, 'Calculator.pm');
	open my $fh, '>', $pm or die "Cannot write $pm: $!";
	print $fh $SAMPLE_MODULE;
	close $fh;
	return ($pm, $tmpdir);
}

# --------------------------------------------------
# Helper: write a minimal schema YAML file.
# Returns the absolute path to the written file.
# --------------------------------------------------
sub _make_schema {
	my (%opts) = @_;
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh "module: builtin\n";
	print $fh "function: $opts{function}\n"      if $opts{function};
	print $fh "input:\n  type: $opts{input}\n"   if $opts{input};
	print $fh "output:\n  type: $opts{output}\n" if $opts{output};
	print $fh "$opts{extra}\n"                   if $opts{extra};
	close $fh;
	return $path;
}

# --------------------------------------------------
# Helper: run Mutator generate_mutants() safely from
# within $tmpdir, restoring cwd afterwards.
# Returns the list of mutants.
# --------------------------------------------------
sub _mutants_for {
	my ($mutator, $tmpdir) = @_;
	require Cwd;
	my $orig = Cwd::cwd();
	chdir $tmpdir or die "Cannot chdir $tmpdir: $!";
	my @mutants = eval { $mutator->generate_mutants() };
	my $err = $@;
	chdir $orig;
	die $err if $err;
	return @mutants;
}

# ==================================================================
# PIPELINE 1: SchemaExtractor -> Generator
#
# Extract schemas from a real .pm file, feed them directly into
# Generator::generate(), verify the produced test files are runnable.
# ==================================================================

subtest 'SchemaExtractor -> Generator: extract then generate test file' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	my $out_dir = File::Spec->catdir($tmpdir, 'schemas');
	mkdir $out_dir or die $!;

	# Step 1: extract schemas
	my $extractor = App::Test::Generator::SchemaExtractor->new(
		input_file => $pm,
		output_dir => $out_dir,
	);
	my $schemas = $extractor->extract_all(no_write => 1);
	ok(ref($schemas) eq 'HASH', 'extract_all returns hashref');
	ok(scalar keys %{$schemas} > 0, 'at least one schema extracted');

	# Step 2: generate a test file from each schema
	for my $method (keys %{$schemas}) {
		my $schema   = $schemas->{$method};
		my $test_out = File::Spec->catfile($tmpdir, "$method.t");
		my ($stdout) = capture(sub {
			eval {
				App::Test::Generator->generate(
					schema      => $schema,
					output_file => $test_out,
				);
			};
		});
		is($@, '', "generate() for $method did not croak: $@");
		ok(-f $test_out, "$method: test file written");
		ok(-s $test_out, "$method: test file is non-empty");

		# Verify the generated test file compiles
		is(system($^X, '-c', $test_out), 0,
			"$method: generated test file compiles cleanly");
	}
};

subtest 'SchemaExtractor -> Generator: module key propagated to generated test' => 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);

	for my $method (keys %{$schemas}) {
		is($schemas->{$method}{module}, 'Sample::Calculator',
			"$method: module key is Sample::Calculator");
	}
};

# ==================================================================
# PIPELINE 2: SchemaExtractor -> Planner -> Emitter::Perl
#
# Extract schemas, plan tests, emit Perl test code.
# Verify emitted code references the correct package.
# ==================================================================

subtest 'SchemaExtractor -> Planner -> Emitter: full planning pipeline' => sub {
	my ($pm, $tmpdir) = _make_sample_module();

t/integration.t  view on Meta::CPAN

		package => 'Sample::Calculator',
	);
	my $code = $emitter->emit();
	ok(defined $code,                   'emit() returns defined value');
	ok(length($code) > 0,               'emit() returns non-empty string');
	like($code, qr/Sample::Calculator/, 'emitted code references package');
	like($code, qr/use strict/,         'emitted code has use strict');
	like($code, qr/done_testing/,       'emitted code has done_testing');
};

subtest 'SchemaExtractor -> Planner -> Emitter: boolean output sets boolean_test flag' => 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 a boolean output schema for is_positive
	if(exists $schemas->{is_positive}) {
		$schemas->{is_positive}{output} = { type => 'boolean' };
		my $planner = App::Test::Generator::Planner->new(
			schemas => $schemas,
			package => 'Sample::Calculator',
		);
		my $plans = $planner->plan_all();
		ok($plans->{is_positive}{boolean_test},
			'boolean output type sets boolean_test flag in plan');
	} else {
		ok(1, 'is_positive not extracted — skipping boolean flag check');
	}
};

subtest 'Planner -> Emitter: getset accessor type produces getset block' => sub {
	my $schemas = {
		precision => {
			input     => { val => { type => 'integer' } },
			output    => { type => 'integer' },
			accessor  => { type => 'getset', property => 'precision' },
			_analysis => {},
		},
	};
	my $planner = App::Test::Generator::Planner->new(
		schemas => $schemas,
		package => 'Sample::Calculator',
	);
	my $plans = $planner->plan_all();
	ok($plans->{precision}{getset_test}, 'getset accessor -> getset_test flag set');

	my $emitter = App::Test::Generator::Emitter::Perl->new(
		schema  => $schemas,
		plans   => $plans,
		package => 'Sample::Calculator',
	);
	my $code = $emitter->emit();
	like($code, qr/get\/set works/, 'emitted code contains getset block');
};

# ==================================================================
# PIPELINE 3: Mutator -> full mutation cycle on a real module
#
# Generate mutants, prepare workspace, apply each mutant, verify
# the workspace copy is modified while the original is unchanged.
# ==================================================================

subtest 'Mutator: generate -> prepare_workspace -> apply_mutant pipeline' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	require Cwd;
	my $orig = Cwd::cwd();
	chdir $tmpdir or die $!;

	my $rel_lib = 'lib';
	my $rel_pm  = File::Spec->catfile('lib', 'Sample', 'Calculator.pm');

	my $mutator = App::Test::Generator::Mutator->new(
		file    => $rel_pm,
		lib_dir => $rel_lib,
	);

	# generate_mutants() called while still in $tmpdir
	my @mutants = eval { $mutator->generate_mutants() };
	my $gen_err = $@;

	my $workspace = eval { $mutator->prepare_workspace() };
	my $ws_err    = $@;

	# Read original source while still in $tmpdir
	my $original;
	if(open my $fh, '<', $rel_pm) {
		local $/;
		$original = <$fh>;
		close $fh;
	}

	# Apply first mutant while still in $tmpdir
	my $apply_err;
	if(!$gen_err && !$ws_err && @mutants) {
		eval { $mutator->apply_mutant($mutants[0]) };
		$apply_err = $@;
	}

	# Read source after mutation while still in $tmpdir
	my $after;
	if(open my $fh2, '<', $rel_pm) {
		local $/;
		$after = <$fh2>;
		close $fh2;
	}

	chdir $orig;

	is($gen_err, '',  'generate_mutants() did not croak');
	is($ws_err,  '',  'prepare_workspace() did not croak');
	ok(-d $workspace,  'workspace directory created');
	ok(scalar @mutants > 0, 'at least one mutant generated');
	is($apply_err, '', 'apply_mutant() did not croak');
	is($after, $original, 'original source file unchanged after apply_mutant');
};

subtest 'Mutator: fast mode produces fewer or equal mutants than full mode' => sub {
	my ($pm, $tmpdir) = _make_sample_module();
	require Cwd;



( run in 0.942 second using v1.01-cache-2.11-cpan-e1769b4cff6 )