view release on metacpan or  search on metacpan

t/CoverageGuided_Fuzzer_unit.t  view on Meta::CPAN

	my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
		schema     => { input => { type => 'string' } },
		target_sub => sub { 1 },
	);
	my $after = time();
	ok($f->{seed} >= $before && $f->{seed} <= $after,
		'default seed is approximately time()');
};

subtest 'new() stores optional instance' => sub {
	my $obj = bless {}, 'FakeClass';
	my $f   = _fuzzer(instance => $obj);
	is($f->{instance}, $obj, 'instance stored correctly');
};

subtest 'new() initialises corpus, covered, and bugs to empty' => sub {
	my $f = _fuzzer();
	is(ref($f->{corpus}),  'ARRAY', 'corpus is arrayref');
	is(ref($f->{covered}), 'HASH',  'covered is hashref');
	is(ref($f->{bugs}),    'ARRAY', 'bugs is arrayref');
	is(scalar @{$f->{corpus}},  0, 'corpus initially empty');
	is(scalar @{$f->{bugs}},    0, 'bugs initially empty');
	is(scalar keys %{$f->{covered}}, 0, 'covered initially empty');
};

subtest 'new() each call returns a distinct object' => sub {
	my $f1 = _fuzzer();
	my $f2 = _fuzzer();
	isnt($f1, $f2, 'distinct objects returned');
};

subtest 'new() defaults timeout to 5 seconds' => sub {
	my $f = _fuzzer();
	is($f->{timeout}, 5, 'timeout defaults to 5');
};

subtest 'new() stores supplied timeout' => sub {
	my $f = _fuzzer(timeout => 1);
	is($f->{timeout}, 1, 'timeout stored correctly');
};

# ==================================================================
# Regression: a hanging target_sub must not hang the whole fuzzing
# run. Both the Devel::Cover and non-cover call sites in _run_one /
# _run_with_cover now wrap the target_sub call in an alarm()-bounded
# eval, recording the timeout as a bug rather than blocking forever.
# ==================================================================

subtest 'run() aborts a hanging target_sub via timeout and records a bug' => sub {
	my $f = _fuzzer(
		timeout    => 1,
		iterations => 1,
		target_sub => sub { sleep 30; return 1 },
	);

	my $start = time();
	my $r;
	lives_ok(sub { $r = $f->run() }, 'run() returns rather than hanging');
	my $elapsed = time() - $start;

	ok($elapsed < 25, "run() returned promptly (elapsed=${elapsed}s), not after the full sleep")
		or diag("run() took ${elapsed}s — timeout did not abort the hanging call");

	ok(scalar(@{$f->bugs()}) >= 1, 'hanging call recorded as a bug');
	like($f->bugs()->[0]{error}, qr/timed out/, 'bug error mentions the timeout');
};

subtest 'run() with timeout disabled (0) does not wrap target_sub in alarm' => sub {
	my $f = _fuzzer(
		timeout    => 0,
		iterations => 3,
		target_sub => sub { 1 },
	);
	lives_ok(sub { $f->run() }, 'run() lives with timeout disabled');
};

# ==================================================================
# 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();
	my $r = $f->run();
	ok($r->{corpus_size} >= 0, 'corpus_size is non-negative');
};

subtest 'run() does not croak for target that always returns 1' => sub {
	my $f = _fuzzer(target_sub => sub { 1 });
	lives_ok(sub { $f->run() }, 'run() lives for well-behaved target');