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 )