view release on metacpan or  search on metacpan

t/CoverageGuided_Fuzzer_unit.t  view on Meta::CPAN

	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()
#
# POD spec:
#   Returns bugs arrayref (entries have input and error keys)
# ==================================================================

subtest 'bugs() returns an arrayref' => sub {
	my $f = _fuzzer();
	is(ref($f->bugs()), 'ARRAY', 'bugs() returns arrayref');
};

subtest 'bugs() records errors from valid input that dies' => sub {
	# A target that dies on any defined input — bugs are only recorded
	# 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');
	}
};

# ==================================================================
# save_corpus()
#
# POD spec:
#   Arguments: $path (required)
#   Writes JSON file to $path
#   Croaks when path is missing or file cannot be written
# ==================================================================

subtest 'save_corpus() croaks when path is missing' => sub {
	my $f = _fuzzer();
	throws_ok(
		sub { $f->save_corpus(undef) },
		qr/path required/,
		'undef path croaks',
	);
};

subtest 'save_corpus() croaks when path is not writable' => sub {
	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(