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 )