App-Test-Generator
view release on metacpan or search on metacpan
It reads configuration files in any format,
and optional YAML corpus files.
All of the examples in this documentation are in `YAML` format,
other formats may not work as they aren't so heavily tested.
It then generates a [Test::Most](https://metacpan.org/pod/Test%3A%3AMost)-based fuzzing harness combining:
- Randomized fuzzing of inputs (with edge cases)
- Optional static corpus tests from Perl `%cases` or YAML file (`yaml_cases` key)
- Functional or OO mode (via `$new`)
- Reproducible runs via `$seed` and configurable iterations via `$iterations`
# MUTATION-GUIDED TEST GENERATION
`App::Test::Generator` includes a pipeline that automatically closes the
feedback loop between mutation testing, schema extraction, and fuzz
testing. The goal is that surviving mutants drive the creation of new
tests that kill them on the next run, without manual intervention.
## The Pipeline
input: ""
_STATUS: DIES
### `$yaml_cases` - optional path to a YAML file with the same shape as `%cases`.
### `$seed`
An optional integer.
When provided, the generated `t/fuzz.t` will call `srand($seed)` so fuzz runs are reproducible.
### `$iterations`
An optional integer controlling how many fuzz iterations to perform (default 30).
### `%edge_cases`
An optional hash mapping of extra values to inject.
# Two named parameters
edge_cases:
name: [ '', 'a' x 1024, \"\x{263A}" ]
age: [ -1, 0, 99999999 ]
type_edge_cases:
string: [ '', ' ', "\t", "\n", "\0", 'long' x 1024, chr(0x1F600) ]
number: [ 0, 1.0, -1.0, 1e308, -1e308, 1e-308, -1e-308, 'NaN', 'Infinity' ]
integer: [ 0, 1, -1, 2**31-1, -(2**31), 2**63-1, -(2**63) ]
### `%edge_case_array`
Specify edge case values for routines that accept a single unnamed parameter.
This is specifically designed for simple functions that take one argument without a parameter name.
These edge cases supplement the normal random string generation, ensuring specific problematic values are always tested.
During fuzzing iterations, there's a 40% probability that a test case will use a value from edge\_case\_array instead of randomly generated data.
---
module: Text::Processor
function: sanitize
input:
type: string
min: 1
max: 1000
edge_case_array:
- "<script>alert('xss')</script>"
- "'; DROP TABLE users; --"
- "\0null\0byte"
- "emoji😊test"
- ""
- " "
seed: 42
iterations: 30
### Semantic Data Generators
For property-based testing with [Test::LectroTest](https://metacpan.org/pod/Test%3A%3ALectroTest),
you can use semantic generators to create realistic test data.
`unix_timestamp` is currently fully supported,
other fuzz testing support for `semantic` entries is being developed.
input:
- Defines two transforms: one for positive numbers, one for negative
- Automatically generates properties that verify `abs()` always returns non-negative numbers
Generate the test:
fuzz-harness-generator t/conf/abs.yml > t/abs_property.t
The generated test will include:
- Traditional edge-case tests for boundary conditions
- Random fuzzing with 30 iterations (or as configured)
- Property-based tests that verify the transforms with 1000 trials each
### What Properties Are Tested?
The generator automatically detects and tests these properties based on your transform specifications:
- **Range constraints** - If output has `min` or `max`, verifies results stay within bounds
- **Type preservation** - Ensures numeric inputs produce numeric outputs
- **Definedness** - Verifies the function doesn't return `undef` unexpectedly
- **Specific values** - If output specifies a `value`, checks exact equality
enable: true # Enable property-based testing (default: false)
trials: 1000 # Number of test cases per property (default: 1000)
You can also disable traditional fuzzing and only use property-based tests:
config:
properties:
enable: true
trials: 5000
iterations: 0 # Disable random fuzzing, use only property tests
### When to Use Property-Based Testing
Property-based testing with transforms is particularly useful for:
- Mathematical functions (`abs`, `sqrt`, `min`, `max`, etc.)
- Data transformations (encoding, normalization, sanitization)
- Parsers and formatters
- Functions with clear input-output relationships
- Code that should satisfy mathematical properties (commutativity, associativity, idempotence)
code: $result !~ /<script/i
- name: no_iframes
code: $result !~ /<iframe/i
## GENERATED OUTPUT
The generated test:
- Seeds RND (if configured) for reproducible fuzz runs
- Uses edge cases (per-field and per-type) with configurable probability
- Runs `$iterations` fuzz cases plus appended edge-case runs
- Validates inputs with Params::Get / Params::Validate::Strict
- Validates outputs with [Return::Set](https://metacpan.org/pod/Return%3A%3ASet)
- Runs static `is(... )` corpus tests from Perl and/or YAML corpus
- Runs [Test::LectroTest](https://metacpan.org/pod/Test%3A%3ALectroTest) tests
# METHODS
## generate
Takes a schema file and produces a test file (or STDOUT).
#### input
{ v => { type => 'any', optional => 1 } }
#### output
{ type => 'string' }
# NOTES
`seed` and `iterations` really should be within `config`.
# SEE ALSO
- [Test Coverage Report](https://nigelhorne.github.io/App-Test-Generator/coverage/)
- [App::Test::Generator::Template](https://metacpan.org/pod/App%3A%3ATest%3A%3AGenerator%3A%3ATemplate) - Template of the file of tests created by `App::Test::Generator`
- [App::Test::Generator::SchemaExtractor](https://metacpan.org/pod/App%3A%3ATest%3A%3AGenerator%3A%3ASchemaExtractor) - Create schemas from Perl programs
- [Params::Validate::Strict](https://metacpan.org/pod/Params%3A%3AValidate%3A%3AStrict): Schema Definition
- [Params::Get](https://metacpan.org/pod/Params%3A%3AGet): Input validation
- [Return::Set](https://metacpan.org/pod/Return%3A%3ASet): Output validation
- [Test::LectroTest](https://metacpan.org/pod/Test%3A%3ALectroTest)
bin/extract-schemas view on Meta::CPAN
# Try to build a default instance for object method calls.
# Most OO modules need a $self as the first argument.
# We try new() with no args, then new({}), then give up and fuzz as functions.
my $instance = _try_construct($package);
if ($instance) {
print "Constructed $package instance for method calls.\n";
} else {
print "Could not construct $package instance; fuzzing as functions.\n";
}
print "Fuzzing with $fuzz_iters iterations per method",
($fuzz_all ? ' (all methods)' : ' (methods with known inputs)'),
"...\n\n";
foreach my $method (sort keys %$schemas) {
my $schema = $schemas->{$method};
my $iconf = $schema->{_confidence}{input}{level} // 'low';
unless ($fuzz_all) {
# Skip methods with no input schema at all — there is nothing to fuzz
next if $iconf eq 'none' && !%{ $schema->{input} // {} };
bin/extract-schemas view on Meta::CPAN
}
my $corpus_file = File::Spec->catfile($corpus_dir, "$method.json");
print " Fuzzing $method ($iconf confidence)... ";
my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => $schema,
target_sub => $sub_ref,
instance => $instance,
iterations => $fuzz_iters,
);
$fuzzer->load_corpus($corpus_file) if -f $corpus_file;
my $report = $fuzzer->run();
$fuzzer->save_corpus($corpus_file);
$fuzz_results{$method} = $report;
printf "%d bugs, %d branches covered\n",
bin/extract-schemas view on Meta::CPAN
=head1 EXAMPLES
=head2 Basic Usage
extract-schemas lib/MyModule.pm
=head2 Fuzz methods with known inputs
extract-schemas --fuzz lib/MyModule.pm
=head2 Fuzz everything, 300 iterations, custom corpus dir
extract-schemas --fuzz --fuzz-all --fuzz-iters 300 --corpus-dir t/corpus lib/MyModule.pm
=head2 Incremental fuzzing (corpus grows across runs)
# First run: builds initial corpus
extract-schemas --fuzz lib/MyModule.pm
# Subsequent runs: loads corpus and extends it
extract-schemas --fuzz lib/MyModule.pm
doc/getting-started-blog.md view on Meta::CPAN
output:
type: boolean
config:
test_undef: yes
test_empty: yes
test_nuls: yes
seed: 42
iterations: 100
```
Save this as `t/conf/validate_email.yml`, then run:
```bash
$ fuzz-harness-generator t/conf/validate_email.yml > t/validate_email_fuzz.t
$ prove -v t/validate_email_fuzz.t
```
**What just happened?**
doc/getting-started-blog.md view on Meta::CPAN
value: 0.5
inverted_range_dies:
input:
value: { type: number, value: 50 }
min: { type: number, value: 100 }
max: { type: number, value: 0 }
output:
_STATUS: DIES
iterations: 50
seed: 42
```
This generates tests that verify:
1. The math is correct (transforms)
2. Boundary conditions work (min=0 returns 0, max=100 returns 1)
3. Invalid inputs are rejected (inverted range dies)
4. Random inputs within range work correctly
## The Five-Minute Quick Start
doc/getting-started-blog.md view on Meta::CPAN
age:
type: integer
min: 0
max: 150
optional: true
output:
type: string
seed: 12345
iterations: 50
```
### 3. Generate and run tests
```bash
# Generate the test file
fuzz-harness-generator t/conf/my_function.yml > t/my_function_fuzz.t
# Run it
prove -v t/my_function_fuzz.t
doc/getting-started-blog.md view on Meta::CPAN
output:
type: string
min: 1
matches: "^(?:[A-Za-z]:[/\\\\]|/)" # Windows or Unix absolute path
config:
test_undef: yes
seed: 42
iterations: 50
```
Generated test output:
```
ok 1 - use CGI::Info;
ok 2 - script_path survives
ok 3 - output validates
ok 4 - script_path survives
ok 5 - output validates
# ... 50+ tests of calling with no arguments ...
lib/App/Test/Generator.pm view on Meta::CPAN
It then generates a L<Test::Most>-based fuzzing harness combining:
=over 4
=item * Randomized fuzzing of inputs (with edge cases)
=item * Optional static corpus tests from Perl C<%cases> or YAML file (C<yaml_cases> key)
=item * Functional or OO mode (via C<$new>)
=item * Reproducible runs via C<$seed> and configurable iterations via C<$iterations>
=back
=head1 MUTATION-GUIDED TEST GENERATION
C<App::Test::Generator> includes a pipeline that automatically closes the
feedback loop between mutation testing, schema extraction, and fuzz
testing. The goal is that surviving mutants drive the creation of new
tests that kill them on the next run, without manual intervention.
lib/App/Test/Generator.pm view on Meta::CPAN
input: ""
_STATUS: DIES
=head3 C<$yaml_cases> - optional path to a YAML file with the same shape as C<%cases>.
=head3 C<$seed>
An optional integer.
When provided, the generated C<t/fuzz.t> will call C<srand($seed)> so fuzz runs are reproducible.
=head3 C<$iterations>
An optional integer controlling how many fuzz iterations to perform (default 30).
=head3 C<%edge_cases>
An optional hash mapping of extra values to inject.
# Two named parameters
edge_cases:
name: [ '', 'a' x 1024, \"\x{263A}" ]
age: [ -1, 0, 99999999 ]
lib/App/Test/Generator.pm view on Meta::CPAN
type_edge_cases:
string: [ '', ' ', "\t", "\n", "\0", 'long' x 1024, chr(0x1F600) ]
number: [ 0, 1.0, -1.0, 1e308, -1e308, 1e-308, -1e-308, 'NaN', 'Infinity' ]
integer: [ 0, 1, -1, 2**31-1, -(2**31), 2**63-1, -(2**63) ]
=head3 C<%edge_case_array>
Specify edge case values for routines that accept a single unnamed parameter.
This is specifically designed for simple functions that take one argument without a parameter name.
These edge cases supplement the normal random string generation, ensuring specific problematic values are always tested.
During fuzzing iterations, there's a 40% probability that a test case will use a value from edge_case_array instead of randomly generated data.
---
module: Text::Processor
function: sanitize
input:
type: string
min: 1
max: 1000
edge_case_array:
- "<script>alert('xss')</script>"
- "'; DROP TABLE users; --"
- "\0null\0byte"
- "emoji😊test"
- ""
- " "
seed: 42
iterations: 30
=head3 Semantic Data Generators
For property-based testing with L<Test::LectroTest>,
you can use semantic generators to create realistic test data.
C<unix_timestamp> is currently fully supported,
other fuzz testing support for C<semantic> entries is being developed.
input:
lib/App/Test/Generator.pm view on Meta::CPAN
Generate the test:
fuzz-harness-generator t/conf/abs.yml > t/abs_property.t
The generated test will include:
=over 4
=item * Traditional edge-case tests for boundary conditions
=item * Random fuzzing with 30 iterations (or as configured)
=item * Property-based tests that verify the transforms with 1000 trials each
=back
=head3 What Properties Are Tested?
The generator automatically detects and tests these properties based on your transform specifications:
=over 4
lib/App/Test/Generator.pm view on Meta::CPAN
enable: true # Enable property-based testing (default: false)
trials: 1000 # Number of test cases per property (default: 1000)
You can also disable traditional fuzzing and only use property-based tests:
config:
properties:
enable: true
trials: 5000
iterations: 0 # Disable random fuzzing, use only property tests
=head3 When to Use Property-Based Testing
Property-based testing with transforms is particularly useful for:
=over 4
=item * Mathematical functions (C<abs>, C<sqrt>, C<min>, C<max>, etc.)
=item * Data transformations (encoding, normalization, sanitization)
lib/App/Test/Generator.pm view on Meta::CPAN
=head2 GENERATED OUTPUT
The generated test:
=over 4
=item * Seeds RND (if configured) for reproducible fuzz runs
=item * Uses edge cases (per-field and per-type) with configurable probability
=item * Runs C<$iterations> fuzz cases plus appended edge-case runs
=item * Validates inputs with Params::Get / Params::Validate::Strict
=item * Validates outputs with L<Return::Set>
=item * Runs static C<is(... )> corpus tests from Perl and/or YAML corpus
=item * Runs L<Test::LectroTest> tests
=back
lib/App/Test/Generator.pm view on Meta::CPAN
croak 'Usage: generate(schema_file [, outfile])' if(scalar(@_) == 0);
# Accept both class-method call (App::Test::Generator->generate(...))
# and plain-function call with a hashref (generate({...})).
# In the method form the first arg is the class name (a plain string);
# in the function form with a hashref the first arg IS the hashref.
my $class = (ref($_[0]) ne 'HASH') ? shift : undef;
my ($schema_file, $test_file, $schema);
# Globals loaded from the user's conf (all optional except function maybe)
my ($module, $function, $new, $yaml_cases);
my ($seed, $iterations);
if((ref($_[0]) eq 'HASH') || defined($_[2])) {
# Modern API
my $params = Params::Validate::Strict::validate_strict({
args => Params::Get::get_params(undef, \@_),
schema => {
input_file => { type => 'string', optional => 1 },
schema_file => { type => 'string', optional => 1 },
output_file => { type => 'string', optional => 1 },
schema => { type => 'hashref', optional => 1 },
lib/App/Test/Generator.pm view on Meta::CPAN
my %edge_cases = %{$schema->{edge_cases}} if(exists($schema->{edge_cases}));
my %type_edge_cases = %{$schema->{type_edge_cases}} if(exists($schema->{type_edge_cases}));
$module = $schema->{module} if(exists($schema->{module}) && length($schema->{module}));
$function = $schema->{function} if(exists($schema->{function}));
if(exists($schema->{new})) {
$new = defined($schema->{'new'}) ? $schema->{new} : '_UNDEF';
}
$yaml_cases = $schema->{yaml_cases} if(exists($schema->{yaml_cases}));
$seed = $schema->{seed} if(exists($schema->{seed}));
$iterations = $schema->{iterations} if(exists($schema->{iterations}));
my @edge_case_array = @{$schema->{edge_case_array}} if(exists($schema->{edge_case_array}));
_validate_config($schema);
my %config = %{$schema->{config}} if(exists($schema->{config}));
_normalize_config(\%config);
# Guess module name from config file if not set
if(!$module) {
lib/App/Test/Generator.pm view on Meta::CPAN
} elsif($module eq $MODULE_BUILTIN) {
undef $module;
}
if($module && length($module) && ($module ne 'builtin')) {
_validate_module($module, $schema_file);
}
# sensible defaults
$function ||= 'run';
$iterations ||= DEFAULT_ITERATIONS; # default fuzz runs if not specified
$seed = undef if defined $seed && $seed eq ''; # treat empty as undef
# --- YAML corpus support (yaml_cases is filename string) ---
my %yaml_corpus_data;
if (defined $yaml_cases) {
croak("$yaml_cases: $!") if(!-f $yaml_cases);
my $yaml_data = LoadFile(Encode::decode('utf8', $yaml_cases));
if ($yaml_data && ref($yaml_data) eq 'HASH') {
# Validate that the corpus inputs are arrayrefs
lib/App/Test/Generator.pm view on Meta::CPAN
croak("Boolean is expected to return $expected_str");
}
} else {
$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
}
}
}
}
}
# Prepare seed/iterations code fragment for the generated test
my $seed_code = '';
if (defined $seed) {
# ensure integer-ish
$seed = int($seed);
$seed_code = "srand($seed);\n";
}
my $determinism_code = 'my $result2;' .
'eval { $result2 = do { ' . (defined($position_code) ? $position_code : $call_code) . " }; };\n" .
'is_deeply($result2, $result, "deterministic result for same input");' .
lib/App/Test/Generator.pm view on Meta::CPAN
config_code => $config_code,
seed_code => $seed_code,
input_code => $input_code,
output_code => $output_code,
transforms_code => $transforms_code,
corpus_code => $corpus_code,
call_code => $call_code,
position_code => $position_code,
determinism_code => $determinism_code,
function => $function,
iterations_code => int($iterations),
use_properties => $use_properties,
transform_properties_code => $transform_properties_code,
property_trials => $config{properties}{trials} // DEFAULT_PROPERTY_TRIALS,
relationships_code => $relationships_code,
module => $module
};
my $test;
$tt->process($template, $vars, \$test) or croak($tt->error());
lib/App/Test/Generator.pm view on Meta::CPAN
code => $prop_code,
description => $prop_desc,
};
}
return @properties;
}
=head1 NOTES
C<seed> and C<iterations> really should be within C<config>.
=head1 SEE ALSO
=over 4
=item * L<Test Coverage Report|https://nigelhorne.github.io/App-Test-Generator/coverage/>
=item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>
=item * L<App::Test::Generator::SchemaExtractor> - Create schemas from Perl programs
lib/App/Test/Generator/CoverageGuidedFuzzer.pm view on Meta::CPAN
Version 0.39
=head1 SYNOPSIS
use App::Test::Generator::CoverageGuidedFuzzer;
my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => $yaml_schema,
target_sub => \&My::Module::validate,
iterations => 200,
seed => 42,
);
my $report = $fuzzer->run();
$fuzzer->save_corpus('t/corpus/validate.json');
=head1 DESCRIPTION
Implements coverage-guided fuzzing on top of App::Test::Generator's
existing schema-driven input generation. Instead of purely random
generation it:
=over 4
=item 1. Generates or mutates a structured input
=item 2. Runs the target sub under Devel::Cover to capture branch hits
=item 3. Keeps inputs that discover new branches in a corpus
=item 4. Preferentially mutates corpus entries in future iterations
=back
This is the Perl equivalent of what AFL/libFuzzer do at the byte level,
but operating on typed, schema-validated Perl data structures.
=head1 METHODS
=head2 new
Construct a new coverage-guided fuzzer.
my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => $yaml_schema,
target_sub => \&My::Module::validate,
iterations => 200,
seed => 42,
instance => $obj, # optional pre-built object for method calls
);
=head3 Arguments
=over 4
=item * C<schema>
A hashref representing the parsed YAML schema for the target function.
Required.
=item * C<target_sub>
A CODE reference to the function under test. Required.
=item * C<iterations>
Number of fuzzing iterations to run. Optional - defaults to 100.
=item * C<seed>
Random seed for reproducible runs. Optional - defaults to C<time()>.
=item * C<instance>
An optional pre-built object to use as the invocant when calling the
target sub as a method.
lib/App/Test/Generator/CoverageGuidedFuzzer.pm view on Meta::CPAN
A blessed hashref. Croaks if C<schema> or C<target_sub> is missing.
=head3 API specification
=head4 input
{
schema => { type => HASHREF },
target_sub => { type => CODEREF },
iterations => { type => SCALAR, optional => 1 },
seed => { type => SCALAR, optional => 1 },
instance => { type => OBJECT, optional => 1 },
}
=head4 output
{
type => OBJECT,
isa => 'App::Test::Generator::CoverageGuidedFuzzer',
}
lib/App/Test/Generator/CoverageGuidedFuzzer.pm view on Meta::CPAN
sub new {
my ($class, %args) = @_;
croak 'schema required' unless $args{schema};
croak 'target_sub required' unless $args{target_sub};
my $self = bless {
schema => $args{schema},
target_sub => $args{target_sub},
instance => $args{instance},
iterations => $args{iterations} // $DEFAULT_ITERATIONS,
seed => $args{seed} // time(),
corpus => [], # [{input => ..., coverage => {...}}]
covered => {}, # "file:line:branch" => 1
bugs => [], # [{input => ..., error => ...}]
stats => {
total => 0,
interesting => 0,
bugs => 0,
coverage => 0,
},
lib/App/Test/Generator/CoverageGuidedFuzzer.pm view on Meta::CPAN
my $report = $fuzzer->run();
printf "Branches covered: %d\n", $report->{branches_covered};
printf "Bugs found: %d\n", $report->{bugs_found};
=head3 Arguments
None beyond C<$self>.
=head3 Returns
A hashref with keys C<total_iterations>, C<interesting_inputs>,
C<corpus_size>, C<branches_covered>, C<bugs_found>, and C<bugs>.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' },
}
=head4 output
{
type => HASHREF,
keys => {
total_iterations => { type => SCALAR },
interesting_inputs => { type => SCALAR },
corpus_size => { type => SCALAR },
branches_covered => { type => SCALAR },
bugs_found => { type => SCALAR },
bugs => { type => ARRAYREF },
},
}
=cut
sub run {
my ($self) = @_;
# Phase 1: seed the corpus with a small set of random inputs
$self->_seed_corpus();
# Phase 2: main fuzzing loop — alternate between mutation and exploration
for my $i (1 .. $self->{iterations}) {
my $input;
if(@{ $self->{corpus} } && rand() < $CORPUS_MUTATE_RATIO) {
# Mutate a randomly chosen corpus entry
my $parent = $self->{corpus}[ int(rand(@{ $self->{corpus} })) ];
$input = $self->_mutate($parent->{input});
} else {
# Fresh random generation for exploration
$input = $self->_generate_random();
}
lib/App/Test/Generator/CoverageGuidedFuzzer.pm view on Meta::CPAN
# returned by run().
#
# Entry: None beyond $self.
# Exit: Returns a report hashref.
# Side effects: None.
# --------------------------------------------------
sub _build_report {
my $self = $_[0];
return {
total_iterations => $self->{stats}{total},
interesting_inputs => $self->{stats}{interesting},
corpus_size => scalar @{ $self->{corpus} },
branches_covered => $self->{stats}{coverage},
bugs_found => $self->{stats}{bugs},
bugs => $self->{bugs},
};
}
=head1 AUTHOR
lib/App/Test/Generator/Template.pm view on Meta::CPAN
# Optional deduplication
# my %seen;
# @cases = grep { !$seen{join '|', %$_}++ } @cases;
# Random data test cases
# Uses type_edge_cases sometimes
if(scalar keys %input) {
if(((scalar keys %input) == 1) && exists($input{'type'}) && !ref($input{'type'})) {
# our %input = ( type => 'string' );
my $type = $input{'type'};
for (1..[% iterations_code %]) {
my $case_input;
if (@edge_case_array && rand() < PROB_EDGE_CASE) {
# Sometimes pick a field-specific edge-case
$case_input = _pick_from(\@edge_case_array);
} elsif(exists $type_edge_cases{$type} && rand() < 0.3) {
# Sometimes pick a type-level edge-case
$case_input = _pick_from($type_edge_cases{$type});
} elsif($type eq 'string') {
if($input{matches}) {
$case_input = Data::Random::String::Matches->create_random_string({ regex => $input{'matches'} });
lib/App/Test/Generator/Template.pm view on Meta::CPAN
next if($field =~ /^_/); # Ignore comments
if(!grep({ $_ eq $field } ('type', 'min', 'max', 'optional', 'matches', 'can', 'position', 'memberof', 'semantic', 'isa'))) {
die("TODO: handle schema keyword '$field'");
}
}
}
# Build a test of the mandatory args
push @cases, { _input => \%mandatory_args, status => 'OK' } if(keys %mandatory_args);
for (1..[% iterations_code %]) {
# One by one change each of the mandatory fields
foreach my $field (keys %input) {
my $spec = $input{$field} || {};
next if $spec->{'memberof'}; # Memberof data is created below
my $type = $spec->{type} || 'string';
my %case_input = (%mandatory_args);
# 1) Sometimes pick a field-specific edge-case
if (exists $edge_cases{$field} && rand() < PROB_EDGE_CASE) {
push @cases, { _input => \%case_input, status => 'OK' } if(keys %case_input);
t/30-basics.t view on Meta::CPAN
# Don't test the legacy format any more
# open my $fh, '>', $conf_file or die $!;
# print $fh <<"CONF";
# our \$module = 'Test::Simple';
# our \$function = 'ok';
# our \%input = ( arg1 => { 'type' => 'string' } );
# our \%output = ( type => 'string' );
# our \%cases = (
# basic => [ 'foo', 'bar' ],
# );
# our \$iterations = 3;
# our \@edge_case_array = ( 'undef', '', ' ' );
# our \$yaml_cases = '$yaml_file';
# CONF
open my $fh, '>', $conf_file or die $!;
print $fh <<"CONF";
---
module: Test::Simple
function: ok
t/30-basics.t view on Meta::CPAN
type: string
output:
type: string
cases:
basic:
- "foo"
- "bar"
iterations: 3
edge_case_array:
- "undef"
- ""
- " "
yaml_cases: $yaml_file
CONF
t/CoverageGuided_Fuzzer.t view on Meta::CPAN
BEGIN { use_ok('App::Test::Generator::CoverageGuidedFuzzer') }
# ------------------------------------------------------------------
# Helper: minimal valid fuzzer construction
# ------------------------------------------------------------------
sub _fuzzer {
my (%args) = @_;
return App::Test::Generator::CoverageGuidedFuzzer->new(
schema => $args{schema} // { input => { type => 'string' } },
target_sub => $args{target_sub} // sub { 1 },
iterations => $args{iterations} // 0,
seed => $args{seed} // 42,
exists $args{instance} ? (instance => $args{instance}) : (),
);
}
# ==================================================================
# new — validation
# ==================================================================
subtest 'new() croaks when schema is missing' => sub {
throws_ok(
t/CoverageGuided_Fuzzer.t view on Meta::CPAN
'missing target_sub croaks',
);
};
subtest 'new() returns a blessed object' => sub {
my $f = _fuzzer();
ok(defined $f, 'new() returns defined value');
isa_ok($f, 'App::Test::Generator::CoverageGuidedFuzzer');
};
subtest 'new() defaults iterations to 100' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => {} },
target_sub => sub { 1 },
seed => 42,
);
is($f->{iterations}, 100, 'iterations defaults to 100');
};
subtest 'new() stores explicit iterations' => sub {
my $f = _fuzzer(iterations => 50);
is($f->{iterations}, 50, 'explicit iterations stored');
};
subtest 'new() stores seed and initialises srand' => sub {
my $f = _fuzzer(seed => 99);
is($f->{seed}, 99, 'seed stored');
};
subtest 'new() initialises corpus, covered, bugs, and stats' => sub {
my $f = _fuzzer();
is(ref($f->{corpus}), 'ARRAY', 'corpus is arrayref');
t/CoverageGuided_Fuzzer.t view on Meta::CPAN
}
};
# ==================================================================
# _build_report
# ==================================================================
subtest '_build_report() returns hashref with all required keys' => sub {
my $f = _fuzzer();
my $r = $f->_build_report();
is(ref($r), 'HASH', 'returns hashref');
for my $key (qw(total_iterations interesting_inputs corpus_size
branches_covered bugs_found bugs)) {
ok(exists $r->{$key}, "$key present in report");
}
};
subtest '_build_report() reflects current stats' => sub {
my $f = _fuzzer();
$f->{stats}{total} = 10;
$f->{stats}{interesting} = 3;
$f->{stats}{coverage} = 7;
$f->{stats}{bugs} = 1;
push @{$f->{corpus}}, { input => 'x', coverage => {} };
push @{$f->{bugs}}, { input => 'y', error => 'oops' };
my $r = $f->_build_report();
is($r->{total_iterations}, 10, 'total_iterations from stats');
is($r->{interesting_inputs}, 3, 'interesting_inputs from stats');
is($r->{branches_covered}, 7, 'branches_covered from stats');
is($r->{bugs_found}, 1, 'bugs_found from stats');
is($r->{corpus_size}, 1, 'corpus_size from corpus array');
is(ref($r->{bugs}), 'ARRAY', 'bugs is arrayref');
};
# ==================================================================
# _validate_value
# ==================================================================
t/CoverageGuided_Fuzzer.t view on Meta::CPAN
my $f = _fuzzer();
throws_ok(
sub { $f->load_corpus('/nonexistent/path/corpus.json') },
qr/Cannot read corpus/,
'unreadable file croaks',
);
}
};
# ==================================================================
# run — smoke test (iterations => 0 skips loop)
# ==================================================================
subtest 'run() with iterations=0 returns valid report structure' => sub {
my $f = _fuzzer(iterations => 0);
my $report = $f->run();
is(ref($report), 'HASH', 'run() returns hashref');
for my $key (qw(total_iterations interesting_inputs corpus_size
branches_covered bugs_found bugs)) {
ok(exists $report->{$key}, "$key present");
}
};
subtest 'run() seeds corpus before loop' => sub {
my $f = _fuzzer(iterations => 0);
$f->run();
is(scalar @{$f->corpus()}, 5, 'corpus seeded with 5 entries after run');
};
subtest 'run() with small iteration count completes without error' => sub {
my $called = 0;
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'integer', min => 0, max => 100 } },
target_sub => sub { $called++; return 1 },
iterations => 10,
seed => 42,
);
my $report;
lives_ok(sub { $report = $f->run() }, 'run() with 10 iterations lives');
is($report->{total_iterations}, 10, 'total_iterations is 10');
ok($called > 0, 'target_sub was called');
};
subtest 'run() detects bugs from target_sub die on valid input' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'integer', min => 0, max => 100 } },
target_sub => sub { die "always dies\n" },
iterations => 5,
seed => 42,
);
my $report = $f->run();
# May or may not find bugs depending on whether generated inputs are valid
ok($report->{bugs_found} >= 0, 'bugs_found is non-negative');
is(scalar @{$f->bugs()}, $report->{bugs_found}, 'bugs array matches bugs_found count');
};
done_testing();
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
// 0;
# --------------------------------------------------
# Helper: build a minimal valid fuzzer
# --------------------------------------------------
sub _fuzzer {
my (%args) = @_;
return App::Test::Generator::CoverageGuidedFuzzer->new(
schema => $args{schema} // { input => { type => 'string' } },
target_sub => $args{target_sub} // sub { 1 },
iterations => $args{iterations} // 5,
seed => $args{seed} // 42,
exists $args{instance} ? (instance => $args{instance}) : (),
);
}
# ==================================================================
# new()
#
# POD spec:
# Required: schema (hashref), target_sub (coderef)
# Optional: iterations (default 100), seed (default time()),
# instance
# Returns: blessed hashref
# Croaks: when schema or target_sub is missing
# ==================================================================
subtest 'new() returns a blessed object' => sub {
my $f = _fuzzer();
isa_ok($f, 'App::Test::Generator::CoverageGuidedFuzzer');
};
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
sub {
App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
)
},
qr/target_sub required/,
'missing target_sub croaks',
);
};
subtest 'new() defaults iterations to 100' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
);
is($f->{iterations}, 100, 'iterations defaults to 100');
};
subtest 'new() stores supplied iterations' => sub {
my $f = _fuzzer(iterations => 50);
is($f->{iterations}, 50, 'iterations stored correctly');
};
subtest 'new() stores supplied seed and calls srand' => sub {
my $f = _fuzzer(seed => 999);
is($f->{seed}, 999, 'seed stored correctly');
};
subtest 'new() uses time() as default seed' => sub {
my $before = time();
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
subtest 'new() each call returns a distinct object' => sub {
my $f1 = _fuzzer();
my $f2 = _fuzzer();
isnt($f1, $f2, 'distinct objects returned');
};
# ==================================================================
# run()
#
# POD spec:
# Returns a hashref with keys: total_iterations, interesting_inputs,
# corpus_size, branches_covered, bugs_found, bugs
# ==================================================================
subtest 'run() returns a hashref' => sub {
my $f = _fuzzer();
my $r;
lives_ok(sub { $r = $f->run() }, 'run() lives');
is(ref($r), 'HASH', 'returns hashref');
};
subtest 'run() report contains all required keys' => sub {
my $f = _fuzzer();
my $r = $f->run();
for my $key (qw(total_iterations interesting_inputs
corpus_size branches_covered bugs_found bugs)) {
ok(exists $r->{$key}, "$key key present");
}
};
subtest 'run() total_iterations matches configured iterations' => sub {
my $f = _fuzzer(iterations => 7);
my $r = $f->run();
is($r->{total_iterations}, 7, 'total_iterations equals configured value');
};
subtest 'run() bugs key is an arrayref' => sub {
my $f = _fuzzer();
my $r = $f->run();
is(ref($r->{bugs}), 'ARRAY', 'bugs is arrayref');
};
subtest 'run() corpus_size is non-negative' => sub {
my $f = _fuzzer();
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
my $f = _fuzzer(target_sub => sub { 1 });
lives_ok(sub { $f->run() }, 'run() lives for well-behaved target');
};
subtest 'run() does not croak for target that always dies' => sub {
my $f = _fuzzer(target_sub => sub { die "expected error\n" });
lives_ok(sub { $f->run() }, 'run() lives even when target always dies');
};
subtest 'run() seeds corpus before main loop' => sub {
my $f = _fuzzer(iterations => 0);
$f->run();
# With 0 iterations the corpus is populated only by _seed_corpus
ok(scalar @{$f->corpus()} >= 0, 'corpus seeded even with 0 iterations');
};
subtest 'run() passes instance as first arg to target_sub when set' => sub {
my $invocant;
my $obj = bless {}, 'FakeInvocant';
my $f = _fuzzer(
instance => $obj,
iterations => 3,
target_sub => sub { $invocant = $_[0]; 1 },
);
$f->run();
is($invocant, $obj, 'instance passed as first arg to target_sub');
};
# ==================================================================
# corpus()
#
# POD spec:
# Returns the corpus arrayref (entries have input and coverage keys)
# ==================================================================
subtest 'corpus() returns an arrayref' => sub {
my $f = _fuzzer();
is(ref($f->corpus()), 'ARRAY', 'corpus() returns arrayref');
};
subtest 'corpus() grows after run()' => sub {
my $f = _fuzzer(iterations => 10);
my $before = scalar @{$f->corpus()};
$f->run();
ok(scalar @{$f->corpus()} >= $before,
'corpus size does not decrease after run()');
};
subtest 'corpus() entries have input and coverage keys' => sub {
my $f = _fuzzer(iterations => 5);
$f->run();
for my $entry (@{$f->corpus()}) {
ok(exists $entry->{input}, 'corpus entry has input key');
ok(exists $entry->{coverage}, 'corpus entry has coverage key');
}
};
# ==================================================================
# bugs()
#
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
# when the input is considered valid by the schema
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => {
input => { type => 'string', min => 1, max => 10 },
},
target_sub => sub {
my $v = $_[0];
die "intentional error\n" if defined($v) && length($v) >= 1;
1;
},
iterations => 20,
seed => 42,
);
$f->run();
# May or may not find bugs depending on generated inputs — just verify
# the bugs arrayref is well-formed
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');
}
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
my $f = _fuzzer();
throws_ok(
sub { $f->save_corpus('/no/such/dir/corpus.json') },
qr/Cannot write corpus/,
'unwritable path croaks',
);
};
subtest 'save_corpus() writes a JSON file' => sub {
SKIP: {
skip 'No JSON module available', 3 unless $have_json;
my $f = _fuzzer(iterations => 3);
$f->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
lives_ok(sub { $f->save_corpus($path) }, 'save_corpus() lives');
ok(-f $path, 'corpus file created');
ok(-s $path, 'corpus file is non-empty');
}
};
subtest 'save_corpus() writes valid JSON' => sub {
SKIP: {
skip 'No JSON module available', 2 unless $have_json;
my $f = _fuzzer(iterations => 3);
$f->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
$f->save_corpus($path);
open my $fh, '<', $path or die $!;
my $json = do { local $/; <$fh> };
close $fh;
my $data;
lives_ok(
sub {
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
);
ok(exists $data->{corpus}, 'JSON has corpus key');
ok(exists $data->{seed}, 'JSON has seed key');
ok(exists $data->{bugs}, 'JSON has bugs key');
}
};
subtest 'load_corpus() appends entries to corpus' => sub {
SKIP: {
skip 'No JSON module available', 2 unless $have_json;
my $f1 = _fuzzer(iterations => 5);
$f1->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
$f1->save_corpus($path);
my $f2 = _fuzzer();
my $before = scalar @{$f2->corpus()};
lives_ok(sub { $f2->load_corpus($path) }, 'load_corpus() lives');
ok(scalar @{$f2->corpus()} >= $before,
'corpus grew after load_corpus()');
}
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
my $f = _fuzzer();
throws_ok(
sub { $f->load_corpus('/no/such/corpus.json') },
qr/Cannot read corpus/,
'missing file croaks',
);
};
subtest 'load_corpus() appends entries to corpus' => sub {
# Save a corpus then load it into a new fuzzer
my $f1 = _fuzzer(iterations => 5);
$f1->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
$f1->save_corpus($path);
my $f2 = _fuzzer();
my $before = scalar @{$f2->corpus()};
lives_ok(sub { $f2->load_corpus($path) }, 'load_corpus() lives');
ok(scalar @{$f2->corpus()} >= $before,
'corpus grew after load_corpus()');
};
subtest 'save_corpus() writes a JSON file' => sub {
SKIP: {
skip 'No JSON module available', 3 unless $have_json;
my $f = _fuzzer(iterations => 3);
$f->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
lives_ok(sub { $f->save_corpus($path) }, 'save_corpus() lives');
ok(-f $path, 'corpus file created');
ok(-s $path, 'corpus file is non-empty');
}
};
subtest 'save_corpus() writes valid JSON' => sub {
SKIP: {
skip 'No JSON module available', 2 unless $have_json;
my $f = _fuzzer(iterations => 3);
$f->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
$f->save_corpus($path);
open my $fh, '<', $path or die $!;
my $json = do { local $/; <$fh> };
close $fh;
my $data;
lives_ok(
sub {
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
},
'corpus file contains valid JSON',
);
ok(exists $data->{corpus}, 'JSON has corpus key');
ok(exists $data->{seed}, 'JSON has seed key');
ok(exists $data->{bugs}, 'JSON has bugs key');
}
};
subtest 'save_corpus() and load_corpus() round-trip preserves seed' => sub {
my $f1 = _fuzzer(seed => 12345, iterations => 3);
$f1->run();
my $dir = tempdir(CLEANUP => 1);
my $path = File::Spec->catfile($dir, 'corpus.json');
$f1->save_corpus($path);
open my $fh, '<', $path or die $!;
my $data;
require JSON::MaybeXS;
$data = JSON::MaybeXS->new->decode(do { local $/; <$fh> });
close $fh;
is($data->{seed}, 12345, 'seed preserved in saved corpus');
};
# ==================================================================
# corpus_size() — convenience check via corpus()
# ==================================================================
subtest 'corpus size increases after successive runs' => sub {
my $f = _fuzzer(iterations => 10);
$f->run();
my $size1 = scalar @{$f->corpus()};
$f->run();
my $size2 = scalar @{$f->corpus()};
ok($size2 >= $size1, 'corpus size does not decrease on second run');
};
done_testing();
t/Generator_unit.t view on Meta::CPAN
};
subtest 'generate() respects seed in schema' => sub {
my $s1 = _schema_file(extra => 'seed: 42');
my $s2 = _schema_file(extra => 'seed: 42');
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 'generate() respects iterations in schema' => sub {
my $schema = _schema_file(extra => 'iterations: 5');
my ($out) = capture(sub {
App::Test::Generator->generate($schema);
});
like($out, qr/5/, 'iteration count appears in output');
};
subtest 'generate() can be called as exported function' => sub {
my $schema = _schema_file();
my ($out) = capture(sub {
eval { App::Test::Generator->generate($schema) };
# wrong-type inputs rather than dying, so fuzz "dies" tests fail.
my %no_prove = map { $_ => 1 } qw(generate DB::DB get_data_section new export merge mutate applies_to if render_args_hash render_arrayref_map render_hash);
my @test_files;
my @prove_files;
for my $func (sort keys %$schemas) {
my $schema_file = File::Spec->catfile($tmpdir, "${func}.yml");
next unless -f $schema_file;
# Patch schema: short per-case timeout (3s vs default 10s), no
# test_empty, low iterations, and cap string max lengths.
# The 64K-string cases come from a separate path and are only
# suppressed by setting max; test_empty only removes '' cases.
my $skip_prove = 0;
eval {
my ($schema) = LoadFile($schema_file);
if (ref($schema) eq 'HASH') {
$schema->{iterations} = 3;
$schema->{config}{timeout} = 3;
$schema->{config}{test_empty} = 0;
$schema->{config}{close_stdin} = 1;
# Cap unconstrained file-path string fields to prevent 64K-char test cases.
# Only applied to fields whose name suggests a file path — not general
# string arguments like 's', 'v', etc., which don't enforce length.
if (ref($schema->{input}) eq 'HASH') {
for my $field (keys %{$schema->{input}}) {
my $spec = $schema->{input}{$field};
next unless ref($spec) eq 'HASH';
t/edge_cases.t view on Meta::CPAN
print $fh "module: builtin\nfunction: my_func\n";
print $fh "input:\n type: string\noutput:\n type: string\n";
print $fh "seed: 42\n";
close $fh;
my ($out) = capture(sub {
eval { App::Test::Generator->generate($path) };
});
is($@, '', 'special character schema does not croak');
};
subtest 'Generator: zero iterations produces minimal output' => sub {
my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
print $fh "module: builtin\nfunction: abs\n";
print $fh "input:\n type: number\noutput:\n type: number\n";
print $fh "iterations: 0\n";
close $fh;
my ($out) = capture(sub {
eval { App::Test::Generator->generate($path) };
});
is($@, '', 'zero iterations does not croak');
like($out, qr/done_testing/, 'done_testing present with zero iterations');
};
subtest 'Generator: very large iterations value' => sub {
my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
print $fh "module: builtin\nfunction: abs\n";
print $fh "input:\n type: number\noutput:\n type: number\n";
print $fh "iterations: 999999\n";
close $fh;
my ($out) = capture(sub {
eval { App::Test::Generator->generate($path) };
});
# Should not OOM or hang — just produce output with large iteration count
is($@, '', 'very large iterations value does not croak');
};
subtest 'Generator: nonexistent schema file croaks' => sub {
throws_ok(
sub { App::Test::Generator->generate('/no/such/file.yml') },
qr/No such|not found|Cannot|read/i,
'nonexistent schema file croaks',
);
};
t/edge_cases.t view on Meta::CPAN
open my $fh, '>', $outfile or die $!;
print $fh $code;
close $fh;
is(system($^X, '-c', $outfile), 0, '50-method emitted code compiles');
};
# ==================================================================
# CoverageGuidedFuzzer — boundary and pathological inputs
# ==================================================================
subtest 'CoverageGuidedFuzzer: zero iterations produces seed corpus only' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
my $r;
lives_ok(sub { $r = $f->run() }, 'zero iterations: run lives');
is($r->{total_iterations}, 0, 'zero iterations reported');
ok($r->{corpus_size} >= 0, 'corpus size non-negative');
};
subtest 'CoverageGuidedFuzzer: target that always dies produces bug entries' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string', min => 1, max => 5 } },
target_sub => sub { die "always\n" },
iterations => 5,
seed => 42,
);
lives_ok(sub { $f->run() }, 'always-dying target: run lives');
};
subtest 'CoverageGuidedFuzzer: target that always warns does not crash' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { warn "test warning\n"; return 1 },
iterations => 5,
seed => 42,
);
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
lives_ok(sub { $f->run() }, 'always-warning target: run lives');
};
subtest 'CoverageGuidedFuzzer: integer schema boundary values' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => {
type => 'integer', min => -2**31, max => 2**31 - 1
} },
target_sub => sub { return $_[0] + 0 },
iterations => 10,
seed => 42,
);
lives_ok(sub { $f->run() }, 'INT32 boundary schema: run lives');
};
subtest 'CoverageGuidedFuzzer: boolean schema' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'boolean' } },
target_sub => sub { return $_[0] ? 'yes' : 'no' },
iterations => 10,
seed => 42,
);
lives_ok(sub { $f->run() }, 'boolean schema: run lives');
};
subtest 'CoverageGuidedFuzzer: arrayref schema' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'arrayref' } },
target_sub => sub { return scalar @{$_[0]} },
iterations => 10,
seed => 42,
);
lives_ok(sub { $f->run() }, 'arrayref schema: run lives');
};
subtest 'CoverageGuidedFuzzer: hashref schema' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'hashref' } },
target_sub => sub { return scalar keys %{$_[0]} },
iterations => 10,
seed => 42,
);
lives_ok(sub { $f->run() }, 'hashref schema: run lives');
};
subtest 'CoverageGuidedFuzzer: save_corpus to read-only directory croaks' => sub {
SKIP: {
skip 'running as root', 1 if $> == 0;
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 3,
seed => 42,
);
$f->run();
throws_ok(
sub { $f->save_corpus('/no/such/dir/corpus.json') },
qr/Cannot write corpus/,
'unwritable path croaks',
);
}
};
subtest 'CoverageGuidedFuzzer: load_corpus from nonexistent file croaks' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
throws_ok(
sub { $f->load_corpus('/no/such/corpus.json') },
qr/Cannot read corpus/,
'nonexistent corpus file croaks',
);
};
subtest 'CoverageGuidedFuzzer: load_corpus from empty file croaks' => sub {
my ($fh, $path) = tempfile(SUFFIX => '.json', UNLINK => 1);
close $fh; # empty file
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
throws_ok(
sub { $f->load_corpus($path) },
qr/./, # any error is acceptable for malformed JSON
'empty corpus file croaks',
);
};
# ==================================================================
t/extended_tests.t view on Meta::CPAN
# ==================================================================
# CoverageGuidedFuzzer — branch coverage
# ==================================================================
subtest 'CoverageGuidedFuzzer: mutate handles all scalar types' => sub {
use_ok('App::Test::Generator::CoverageGuidedFuzzer');
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
# Exercise _mutate with each scalar type
for my $val (42, 3.14, 'hello', '', undef) {
lives_ok(
sub {
# Access _mutate directly
App::Test::Generator::CoverageGuidedFuzzer::_mutate($f, $val)
},
defined($val) ? "mutate('$val') lives" : 'mutate(undef) lives',
);
}
};
subtest 'CoverageGuidedFuzzer: mutate handles arrayref' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'arrayref' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
my $result;
lives_ok(
sub {
$result = App::Test::Generator::CoverageGuidedFuzzer::_mutate($f, [1, 2, 3])
},
'mutate([1,2,3]) lives',
);
is(ref($result), 'ARRAY', 'mutated arrayref is still an arrayref');
};
subtest 'CoverageGuidedFuzzer: mutate handles hashref' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'hashref' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
my $result;
lives_ok(
sub {
$result = App::Test::Generator::CoverageGuidedFuzzer::_mutate($f, { a => 1, b => 2 })
},
'mutate({a=>1}) lives',
);
is(ref($result), 'HASH', 'mutated hashref is still a hashref');
};
subtest 'CoverageGuidedFuzzer: mutate passes blessed ref through unchanged' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
my $obj = bless {}, 'FakeClass';
my $result = App::Test::Generator::CoverageGuidedFuzzer::_mutate($f, $obj);
is($result, $obj, 'blessed ref passed through unchanged');
};
subtest 'CoverageGuidedFuzzer: _rand_int returns a numeric value' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'integer', min => 5, max => 10 } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
for (1..20) {
my $val = App::Test::Generator::CoverageGuidedFuzzer::_rand_int(
$f, { min => 5, max => 10 }
);
ok(looks_like_number($val), "_rand_int returns numeric value (got $val)");
}
};
subtest 'CoverageGuidedFuzzer: _rand_num returns value within bounds' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'number' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
for (1..10) {
my $val = App::Test::Generator::CoverageGuidedFuzzer::_rand_num(
$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
t/extended_tests.t view on Meta::CPAN
# 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;
t/integration.t view on Meta::CPAN
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');
t/integration.t view on Meta::CPAN
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();
( run in 1.962 second using v1.01-cache-2.11-cpan-96521ef73a4 )