App-Test-Generator
view release on metacpan or search on metacpan
t/CoverageGuided_Fuzzer.t view on Meta::CPAN
my $f = _fuzzer();
my $result = $f->_mutate(undef);
# Returns whatever _generate_random returns â just check it lives
ok(1, '_mutate(undef) lives');
};
subtest '_mutate() handles integer scalar' => sub {
my $f = _fuzzer();
my $result = $f->_mutate(42);
ok(defined $result, '_mutate(42) returns defined value');
};
subtest '_mutate() handles float scalar' => sub {
my $f = _fuzzer();
my $result = $f->_mutate(3.14);
ok(defined $result, '_mutate(3.14) returns defined value');
};
subtest '_mutate() handles string scalar' => sub {
my $f = _fuzzer();
my $result = $f->_mutate('hello');
ok(defined $result, '_mutate("hello") returns defined value');
};
subtest '_mutate() handles arrayref' => sub {
my $f = _fuzzer();
my $result = $f->_mutate([1, 2, 3]);
is(ref($result), 'ARRAY', '_mutate([]) returns arrayref');
};
subtest '_mutate() handles hashref' => sub {
my $f = _fuzzer();
my $result = $f->_mutate({ a => 1 });
is(ref($result), 'HASH', '_mutate({}) returns hashref');
};
subtest '_mutate() passes blessed refs through unchanged' => sub {
my $f = _fuzzer();
my $obj = bless { x => 1 }, 'SomeClass';
my $result = $f->_mutate($obj);
is($result, $obj, 'blessed ref returned unchanged');
};
# ==================================================================
# _generate_for_schema
# ==================================================================
subtest '_generate_for_schema() returns undef for undef spec' => sub {
my $f = _fuzzer();
ok(!defined($f->_generate_for_schema(undef)), 'undef spec -> undef');
};
subtest '_generate_for_schema() returns undef for "undef" string spec' => sub {
my $f = _fuzzer();
ok(!defined($f->_generate_for_schema('undef')), '"undef" spec -> undef');
};
subtest '_generate_for_schema() generates integer' => sub {
my $f = _fuzzer(seed => 1);
my $v = $f->_generate_for_schema({ type => 'integer', min => 0, max => 100 });
ok(defined $v, 'integer generated');
ok($v =~ /^-?\d+$/, 'looks like integer');
};
subtest '_generate_for_schema() generates boolean 0 or 1' => sub {
my $f = _fuzzer(seed => 1);
for (1..10) {
my $v = $f->_generate_for_schema({ type => 'boolean' });
ok($v == 0 || $v == 1, "boolean value $v is 0 or 1");
}
};
subtest '_generate_for_schema() generates arrayref' => sub {
my $f = _fuzzer(seed => 1);
my $v = $f->_generate_for_schema({ type => 'arrayref' });
is(ref($v), 'ARRAY', 'arrayref generated');
};
subtest '_generate_for_schema() generates hashref' => sub {
my $f = _fuzzer(seed => 1);
my $v = $f->_generate_for_schema({
type => 'hashref',
properties => { name => { type => 'string' } },
});
is(ref($v), 'HASH', 'hashref generated');
ok(exists $v->{name}, 'property key present');
};
subtest '_generate_for_schema() uses edge_case_array when available' => sub {
# With seed fixed, at EDGE_CASE_RATIO=0.40 we expect some hits over 20 tries
my $f = _fuzzer(seed => 42);
my @edge_cases = (999, 1000, 1001);
my $spec = { type => 'integer', edge_case_array => \@edge_cases };
my $hit_edge = 0;
for (1..20) {
my $v = $f->_generate_for_schema($spec);
$hit_edge++ if grep { $_ == $v } @edge_cases;
}
ok($hit_edge > 0, 'edge cases selected at least once in 20 tries');
};
# ==================================================================
# _rand_int boundary bias
# ==================================================================
subtest '_rand_int() returns an integer' => sub {
my $f = _fuzzer(seed => 1);
for (1..20) {
my $v = $f->_rand_int({ min => 5, max => 10 });
ok($v =~ /^-?\d+$/, "rand_int returns integer: $v");
}
};
# ==================================================================
# _rand_string
# ==================================================================
subtest '_rand_string() returns a scalar' => sub {
my $f = _fuzzer(seed => 1);
my $v = $f->_rand_string({ min => 0, max => 10 });
ok(defined $v, 'rand_string returns defined value');
ok(length($v) >= 0 && length($v) <= 10, 'length within spec');
};
( run in 0.558 second using v1.01-cache-2.11-cpan-6aa56a78535 )