App-Test-Generator

 view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

		sub { capture(sub { App::Test::Generator->generate($path) }) },
		qr/function|module|parse|load/i,
		'whitespace-only schema croaks gracefully',
	);
};

subtest 'Generator: schema with function but no input or output' => sub {
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh "module: builtin\nfunction: abs\n";
	close $fh;
	my ($out, $err) = capture(sub {
		eval { App::Test::Generator->generate($path) };
	});
	is($@, '', 'no input/output schema does not croak');
	ok(length($out) > 0, 'some output produced even without input/output');
};

subtest 'Generator: schema with deeply nested input types' => sub {
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh <<'END_YAML';
module: builtin
function: my_func
input:
  data:
    type: hashref
output:
  type: hashref
END_YAML
	close $fh;
	my ($out) = capture(sub {
		eval { App::Test::Generator->generate($path) };
	});
	is($@, '', 'hashref input/output does not croak');
};

subtest 'Generator: schema with very long function name' => sub {
	my $long_name = 'a' x 200;
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh "module: builtin\nfunction: $long_name\n";
	print $fh "input:\n  type: string\noutput:\n  type: string\n";
	close $fh;
	my ($out) = capture(sub {
		eval { App::Test::Generator->generate($path) };
	});
	is($@, '', '200-char function name does not croak');
	like($out, qr/$long_name/, 'long function name appears in output');
};

subtest 'Generator: schema with special characters in string values' => sub {
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	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',
	);
};

subtest 'Generator: undef schema file croaks' => sub {
	throws_ok(
		sub { App::Test::Generator->generate(undef) },
		qr/Usage|required|defined/i,
		'undef schema file croaks',
	);
};

subtest 'Generator: schema with min > max for integer input' => sub {
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh "module: builtin\nfunction: my_func\n";
	print $fh "input:\n  x:\n    type: integer\n    min: 100\n    max: 1\n";
	print $fh "output:\n  type: integer\n";
	close $fh;
	# Should not crash even with inverted constraints
	lives_ok(
		sub { capture(sub { App::Test::Generator->generate($path) }) },
		'inverted min/max does not crash',
	);
};

subtest 'Generator: schema with unicode function name' => sub {
	my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	binmode $fh, ':utf8';
	print $fh "module: builtin\nfunction: my_func\n";
	print $fh "input:\n  type: string\noutput:\n  type: string\n";
	close $fh;
	lives_ok(
		sub { capture(sub { App::Test::Generator->generate($path) }) },
		'unicode in schema file does not crash',
	);
};

# ==================================================================
# Generator — render helpers with pathological inputs
# ==================================================================

subtest 'perl_quote: handles undef' => sub {
	is(App::Test::Generator::perl_quote(undef), 'undef',
		'undef -> literal undef string');
};

subtest 'perl_quote: handles empty string' => sub {
	is(App::Test::Generator::perl_quote(''), "''", 'empty string -> empty quotes');
};

subtest 'perl_quote: handles string with single quotes' => sub {
	my $result = App::Test::Generator::perl_quote("it's");
	ok(defined $result, 'string with single quote handled');
	like($result, qr/it/, 'original content preserved');

t/edge_cases.t  view on Meta::CPAN

# ==================================================================
# Emitter::Perl — boundary and pathological inputs
# ==================================================================

subtest 'Emitter::Perl: all plan flags set simultaneously' => sub {
	my $e = App::Test::Generator::Emitter::Perl->new(
		schema  => { m => { input => {}, output => {} } },
		plans   => { m => {
			basic_test          => 1,
			getter_test         => 1,
			setter_test         => 1,
			getset_test         => 1,
			chaining_test       => 1,
			error_handling_test => 1,
			context_tests       => 1,
			object_injection_test => 1,
			boolean_test        => 1,
			void_context_test   => 1,
		} },
		package => 'My::Module',
	);
	my $code;
	lives_ok(sub { $code = $e->emit() }, 'all flags: emit lives');
	like($code, qr/done_testing/, 'all flags: done_testing present');
};

subtest 'Emitter::Perl: method name with special characters in comment' => sub {
	my $e = App::Test::Generator::Emitter::Perl->new(
		schema  => { 'import' => { input => {}, output => {} } },
		plans   => { 'import' => { basic_test => 1 } },
		package => 'My::Module',
	);
	lives_ok(sub { $e->emit() }, 'reserved word method name does not crash');
};

subtest 'Emitter::Perl: 50-method schema emits valid code' => sub {
	my (%schemas, %plans);
	for my $i (1..50) {
		$schemas{"method_$i"} = { input => {}, output => {} };
		$plans{"method_$i"}   = { basic_test => 1 };
	}
	my $e = App::Test::Generator::Emitter::Perl->new(
		schema  => \%schemas,
		plans   => \%plans,
		package => 'My::Module',
	);
	my $code;
	lives_ok(sub { $code = $e->emit() }, '50-method emit lives');
	my $tmpdir  = tempdir(CLEANUP => 1);
	my $outfile = File::Spec->catfile($tmpdir, 'big.t');
	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',
	);
};

# ==================================================================
# Cross-module: render helpers handle values from real schemas
# ==================================================================

subtest 'render helpers: handle Regexp values without crashing' => sub {
	my $re     = qr/^[a-z]+$/i;
	my $result = App::Test::Generator::perl_quote($re);
	ok(defined $result,        'Regexp handled by perl_quote');
	like($result, qr/qr\{/,   'Regexp rendered as qr{}');
};

subtest 'render_args_hash: handles Regexp values' => sub {
	my $result = App::Test::Generator::render_args_hash({
		matches => qr/^\d+$/,
		type    => 'string',
	});
	ok(defined $result,     'Regexp in args hash handled');
	like($result, qr/qr\{/, 'Regexp rendered in args hash');
};

subtest 'render_hash: skips undef sub-values gracefully' => sub {
	my $result = App::Test::Generator::render_hash({
		param => { type => 'string', min => undef, max => 10 }
	});
	ok(defined $result,        'undef sub-value handled');
	unlike($result, qr/min/,   'undef min key omitted');
	like($result,   qr/max/,   'defined max key present');
};

done_testing();



( run in 0.876 second using v1.01-cache-2.11-cpan-71847e10f99 )