App-Test-Generator
view release on metacpan or search on metacpan
lib/App/Test/Generator/Template.pm view on Meta::CPAN
} else {
push @cases, { %mandatory_args, ( $arg_name => $string ) };
}
}
}
# --- memberof ---
if (defined $spec->{memberof}) {
my @set = @{ $spec->{memberof} };
push @cases, { %mandatory_args, ( $arg_name => $set[0] ) } if @set;
push @cases, { %mandatory_args, ( $arg_name => '_not_in_set_', _STATUS => 'DIES' ) };
}
# --- notmemberof ---
if (defined $spec->{notmemberof}) {
my @set = @{ $spec->{notmemberof} };
push @cases, { %mandatory_args, ( $arg_name => $set[0], _STATUS => 'DIES' ) } if @set;
push @cases, { %mandatory_args, ( $arg_name => '_not_in_set_' ) };
}
# --- semantic ---
if(defined(my $semantic = $spec->{'semantic'})) {
if(defined(my $semantic = $spec->{'semantic'})) {
push @cases, { %mandatory_args, ( -1, _STATUS => 'DIES' ) },
{ %mandatory_args, ( $arg_name => 0 ) },
{ %mandatory_args, ( $arg_name => 1 ) },
{ %mandatory_args, ( $arg_name => time ) },
{ %mandatory_args, ( $arg_name => 2147483647 ) },
lib/App/Test/Generator/Template.pm view on Meta::CPAN
}
# Add notmemberof tests
if (defined $spec->{notmemberof}) {
my @blacklist = @{$spec->{notmemberof}};
# Each blacklisted value should die
foreach my $val (@blacklist) {
push @cases, { %mandatory_args, ( $field => $val, _STATUS => 'DIES' ) };
}
# Non-blacklisted value should pass
push @cases, { %mandatory_args, ( $field => '_not_in_blacklist_' ) };
}
# semantic tests
if(defined(my $semantic = $spec->{'semantic'})) {
if($semantic eq 'unix_timestamp') {
push @cases, { %mandatory_args, ( -1, _STATUS => 'DIES' ) },
{ %mandatory_args, ( 0 ) },
{ %mandatory_args, ( 1 ) },
{ %mandatory_args, ( time ) },
{ %mandatory_args, ( 2147483647 ) },
t/40-more.t view on Meta::CPAN
};
# Test YAML corpus validation
subtest 'YAML corpus validation' => sub {
my $corpus_conf = File::Spec->catfile($dir, 'corpus_test.yml');
my $corpus_t = File::Spec->catfile($dir, 'corpus_test.t');
my $bad_corpus = File::Spec->catfile($dir, 'bad_corpus.yml');
# Create invalid YAML corpus (non-array values)
write_yaml($bad_corpus, {
'expected1' => 'not_an_array', # Invalid - should be array
'expected2' => { hash => 'value' } # Invalid - should be array
});
write_yaml($corpus_conf, {
module => 'Test::Most',
function => 'test',
input => { test => { type => 'string' } },
output => { type => 'string' },
yaml_cases => $bad_corpus
});
t/Generator.t view on Meta::CPAN
},
qr/enum.*memberof|memberof.*enum/,
'both enum and memberof croaks',
);
};
subtest '_validate_input_semantics() croaks when enum is not an arrayref' => sub {
throws_ok(
sub {
_validate_input_semantics({
input => { x => { type => 'string', enum => 'not_array' } }
})
},
qr/enum must be an arrayref/,
'non-arrayref enum croaks',
);
};
subtest '_validate_input_semantics() croaks when memberof is not an arrayref' => sub {
throws_ok(
sub {
_validate_input_semantics({
input => { x => { type => 'string', memberof => 'not_array' } }
})
},
qr/memberof must be an arrayref/,
'non-arrayref memberof croaks',
);
};
subtest '_validate_input_semantics() passes for valid enum arrayref' => sub {
lives_ok(
sub {
t/Generator.t view on Meta::CPAN
qr/name.*code|code.*name/,
'custom property missing code croaks',
);
};
subtest '_validate_transform_properties() croaks when properties is not an arrayref' => sub {
throws_ok(
sub {
_validate_transform_properties({
transforms => {
t => { properties => 'not_array' }
}
})
},
qr/must be an array/,
'non-arrayref properties croaks',
);
};
subtest '_validate_transform_properties() skips transforms with no properties key' => sub {
lives_ok(
t/Model-Method.t view on Meta::CPAN
$m->add_evidence(category => 'invalid', signal => 'returns_property')
} qr/Invalid evidence category/, 'invalid category croaks';
# Missing category croaks
throws_ok {
$m->add_evidence(signal => 'returns_property')
} qr/Invalid evidence category/, 'missing category croaks';
# Invalid signal croaks
throws_ok {
$m->add_evidence(category => 'return', signal => 'not_a_signal')
} qr/Invalid evidence signal/, 'invalid signal croaks';
# Missing signal croaks
throws_ok {
$m->add_evidence(category => 'return')
} qr/Invalid evidence signal/, 'missing signal croaks';
};
# ==================================================================
# add_evidence -- valid categories and signals
t/Mutant_unit.t view on Meta::CPAN
id => 'X', description => 'x', original => '>', line => 1,
)
},
qr/Missing required attribute: transform/,
'missing transform croaks',
);
};
subtest 'new() croaks when transform is not a CODE reference' => sub {
throws_ok(
sub { _mutant(transform => 'not_a_coderef') },
qr/transform must be a CODE reference/,
'string transform croaks',
);
throws_ok(
sub {
App::Test::Generator::Mutant->new(
id => 'X',
description => 'x',
original => '>',
line => 1,
t/Planner-submodules_unit.t view on Meta::CPAN
ok(!exists $result->{foo}{env}, 'env absent when no dependency');
ok(!exists $result->{foo}{filesystem}, 'filesystem absent when no dependency');
ok(!exists $result->{foo}{time}, 'time absent when no dependency');
ok(!exists $result->{foo}{network}, 'network absent when no dependency');
};
subtest 'Isolation::plan() only plans methods present in strategy' => sub {
my $p = new_ok('App::Test::Generator::Planner::Isolation');
my $schema = {
in_strategy => { _analysis => { side_effects => { purity_level => 'pure' } } },
not_strategy => { _analysis => { side_effects => { purity_level => 'pure' } } },
};
my $result = $p->plan($schema, { in_strategy => 1 });
ok( exists $result->{in_strategy}, 'in_strategy present');
ok(!exists $result->{not_strategy}, 'not_strategy absent');
};
subtest 'Mock::plan() returns a hashref' => sub {
my $p = App::Test::Generator::Planner::Mock->new;
my $result = $p->plan({});
is(ref($result), 'HASH', 'plan() returns a hashref not undef');
};
subtest 'Mock::plan() assigns mock_system for calls_external' => sub {
my $p = App::Test::Generator::Planner::Mock->new;
t/SchemaExtractor.t view on Meta::CPAN
ok($info->{slurpy}, 'slurpy flag set for @param');
ok($info->{optional}, 'slurpy array is optional');
# Slurpy hash parameter
$info = $fn->('%opts', 2);
is($info->{name}, 'opts', 'slurpy hash name extracted');
is($info->{type}, 'hash', 'slurpy hash has hash type');
ok($info->{slurpy}, 'slurpy flag set for %param');
# Non-matching pattern returns undef without dying
is($fn->('not_a_param', 0), undef, 'non-matching pattern returns undef');
done_testing();
};
# ==================================================================
# _infer_type_from_expression
# --------------------------------------------------
# Tests for the return expression type inferrer.
# This function checks booleans (^[01]$) BEFORE integers
# so single 0 and 1 are correctly classified as boolean.
t/SchemaExtractor_function.t view on Meta::CPAN
subtest '_parse_signature_parameter() parses %name as slurpy hash' => sub {
my $e = _extractor();
my $info = $e->_parse_signature_parameter('%opts', 2);
is($info->{name}, 'opts', 'name extracted');
is($info->{type}, 'hash', 'hash type set');
ok($info->{slurpy}, 'slurpy flag set');
};
subtest '_parse_signature_parameter() returns undef for unrecognised pattern' => sub {
my $e = _extractor();
my $info = $e->_parse_signature_parameter('not_a_param', 0);
ok(!defined $info, 'undef returned for unrecognised pattern');
};
# ==================================================================
# _extract_subroutine_attributes
# ==================================================================
subtest '_extract_subroutine_attributes() detects :lvalue attribute' => sub {
my $e = _extractor();
my $result = $e->_extract_subroutine_attributes('sub foo :lvalue { }');
t/cli-benchmark-generator.t view on Meta::CPAN
# representative values respect range constraints
{
my ($exit, $out) = run_cmd($script, '-i', $valid_schema);
is($exit, 0, 'exits cleanly for range-constrained schema');
# negative transform has max => 0 so representative value must be <= 0
like($out, qr/abs\(-\d+\)/, 'negative-constrained variant calls abs with a negative value');
}
# missing input file fails gracefully
{
my ($exit, undef, $err) = run_cmd($script, '-i', 't/conf/does_not_exist.yml');
isnt($exit, 0, 'missing schema causes non-zero exit');
}
# generated script is valid Perl
{
my ($fh, $outfile) = tempfile(SUFFIX => '.pl', UNLINK => 1);
close $fh;
run_cmd($script, '-i', $valid_schema, '-o', $outfile);
# run_cmd prepends $^X -Ilib already; pass only the -c flag and file
t/cli-fuzz-harness-generator.t view on Meta::CPAN
is($exit, 0, 'Normal run exits cleanly');
ok(-e $outfile, 'Output file created');
ok(-s $outfile, 'Output file is non-empty');
unlink $outfile;
}
# Invalid config fails
{
my ($exit, $out, $err) = run_cmd($script, '--dry-run', '--input', 't/conf/does_not_exist.conf');
isnt($exit, 0, 'Invalid config causes failure');
like($err, qr/(No such file|failed|error)/i,
'Error message shown for invalid input');
}
done_testing();
t/edge_cases.t view on Meta::CPAN
# splice a forged entry directly into that arrayref, completely
# bypassing add_evidence()'s category/signal whitelist validation, and
# have it silently summed by resolve_confidence() anyway, since that
# method trusts every entry's weight regardless of provenance.
# ==================================================================
subtest 'Model::Method::evidence_ref: external mutation bypasses add_evidence() validation entirely' => sub {
my $m = App::Test::Generator::Model::Method->new(name => 'm', source => 'sub m {}');
my $ref = $m->evidence_ref;
push @{$ref}, {
category => 'not_a_real_category',
signal => 'not_a_real_signal',
weight => $FORGED_EVIDENCE_WEIGHT,
};
is(scalar($m->evidence), 1,
'forged entry is visible through evidence() despite never passing through add_evidence()');
my $conf = $m->resolve_confidence;
is($conf->{score}, $FORGED_EVIDENCE_WEIGHT,
'forged weight is summed into resolve_confidence() with no provenance check');
is($conf->{level}, 'high',
module: Test::Simple
function: ok
input:
arg1:
type: string
output:
type: string
yaml_cases: /not_there_at_all
CONF
close $fh;
throws_ok(sub { App::Test::Generator->generate($conf_file) }, qr/not_there_at_all:\s/, 'Dies when yaml_cases file is not found');
unlink $conf_file;
open $fh, '>', $conf_file or die $!;
print $fh <<"CONF";
---
module: Test::Simple
function: nan
CONF
t/function.t view on Meta::CPAN
like($shorthand, qr/type\s*=>\s*'string'/, 'shorthand type present unquoted');
# matches pattern is compiled to Regexp before rendering
# so it appears as qr{} not a raw string in the output
my $re_result = $fn->({ field => { type => 'string', matches => 'foo' } });
like($re_result, qr/qr\{/, 'matches compiled to qr{}');
# Unknown type shorthand produces a warning, not a croak
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
$fn->({ x => 'not_a_type' });
ok(@warnings, 'unknown type shorthand produces warning');
done_testing();
};
# ==================================================================
# render_arrayref_map
# --------------------------------------------------
# Tests for the hash-of-arrayrefs renderer used for
# edge_cases and type_edge_cases.
t/function.t view on Meta::CPAN
# Present hashref section is returned directly without copying
my $input = { name => { type => 'string' } };
$schema = { input => $input };
is_deeply($fn->($schema, 'input', 'test.yml'), $input, 'hashref section returned');
# The string 'undef' in a section means the same as absent
$schema = { output => 'undef' };
is_deeply($fn->($schema, 'output', 'test.yml'), {}, "'undef' string treated as absent");
# Wrong type croaks with a message mentioning the section name
$schema = { input => 'not_a_hash' };
throws_ok {
$fn->($schema, 'input', 'test.yml')
} qr/should be a hash/, 'wrong type croaks';
done_testing();
};
# ==================================================================
# _is_numeric_transform and _is_string_transform
# --------------------------------------------------
t/function.t view on Meta::CPAN
# Module alone is sufficient — same warning suppression as above
lives_ok {
local $SIG{__WARN__} = sub {};
$fn->({ module => 'Foo' })
} 'module alone is sufficient';
# Invalid input type string croaks with a clear message
throws_ok {
local $SIG{__WARN__} = sub {};
$fn->({ function => 'foo', input => 'not_undef' })
} qr/Invalid input specification/, 'invalid input type croaks';
# The string 'undef' for input is accepted and the key is removed
my $schema = { function => 'foo', input => 'undef' };
lives_ok {
local $SIG{__WARN__} = sub {};
$fn->($schema)
} "'undef' input accepted";
ok(!exists($schema->{input}), "input key removed when set to 'undef'");
t/function.t view on Meta::CPAN
input => {
x => { type => 'string', enum => ['a'], memberof => ['a'] }
}
})
} qr/both enum and memberof/, 'enum and memberof together croaks';
# memberof value must be an arrayref not a plain scalar
throws_ok {
$fn->({
input => {
x => { type => 'string', memberof => 'not_array' }
}
})
} qr/must be an arrayref/, 'non-arrayref memberof croaks';
done_testing();
};
# ==================================================================
# _detect_transform_properties
# --------------------------------------------------
t/test-generator-index.t view on Meta::CPAN
# parse_version
# ==================================================================
subtest 'parse_version() returns a version object for valid strings' => sub {
my $v = parse_version('5.036000');
ok(defined $v, '5.036000 parsed');
ok($v->stringify, 'version object stringifies');
};
subtest 'parse_version() returns undef for garbage' => sub {
my $v = parse_version('not_a_version');
ok(!defined $v, 'garbage returns undef');
};
subtest 'parse_version() supports comparison operators' => sub {
my $old = parse_version('5.034000');
my $new = parse_version('5.036000');
ok($new > $old, '5.036 > 5.034');
ok($old < $new, '5.034 < 5.036');
};
subtest 'Generator::render_hash - carps and skips key whose scalar value is not a recognised type' => sub {
# POD: "A scalar value that is a recognised type string is expanded
# ... Any other non-hashref value is skipped with a warning." This
# distinguishes the valid-type-shorthand branch (already covered in
# t/Generator.t) from the invalid-scalar-value branch, which is not
# tested anywhere else.
my $warning;
local $SIG{__WARN__} = sub { $warning = $_[0] };
my $result = App::Test::Generator::render_hash({ arg1 => 'not_a_real_type' });
is($result, '', 'key with unrecognised scalar value contributes nothing to the output');
like($warning, qr/skipping key 'arg1'/, 'carp warns about the skipped key');
done_testing();
};
subtest 'Generator::generate - quiet flag is accepted but documented as not yet implemented' => sub {
# POD now states quiet is "accepted but not yet implemented; has no
# effect". Pass it both ways and confirm generate() neither croaks
( run in 1.466 second using v1.01-cache-2.11-cpan-9581c071862 )