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 )