App-Test-Generator
view release on metacpan or search on metacpan
yamltest_hints: boundary_values: [0, 1, 100, 255]
detected from code invalid_inputs: ['', undef, -1]
from validation checks equivalence_classes: []
0.21 Sun Dec 14 08:07:09 EST 2025
Schemaextractor: don't put the package name as the argument
Validate config settings better
Fix max string testing with non-ASCII characters
Changed rand_str to be a unified generator that randomly produces codepoint strings,
grapheme clusters, ZWJ emoji sequences, or aggressive Unicode fuzz strings
Schemaextractor: Added advanced type detection for DateTime objects, file handles, coderefs, and enum validation patterns
Added enum as a synonym of memberof
Added tests for unix_timestamp semantic type
0.20 Fri Dec 5 07:53:43 EST 2025
Added the --version flag to fuzz-harness-generator
Ensure the max value of string is honoured better
Fix array context detection to only match return statements
Improve chances of detecting a boolean output
Make the list context detection more specific
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
=back
The module is particularly valuable for large codebases where manual schema
creation would be prohibitively time-consuming, and for maintaining test
coverage as code evolves through continuous integration pipelines.
=head2 Advanced Type Detection
The schema extractor includes enhanced type detection capabilities that identify specialized Perl types beyond basic strings and integers.
L<DateTime> and L<Time::Piece> objects are detected through isa() checks and method call patterns, while date strings (ISO 8601, YYYY-MM-DD) and UNIX timestamps are recognized through regex validation and numeric range checks.
File handles and file paths are identified via I/O operations and file test operators, coderefs are detected through ref() checks and invocation patterns, and enum-like parameters are extracted from validation code including regex patterns (C</^(a|b|...
These detected types are preserved in the generated YAML schemas with appropriate semantic annotations, enabling test generators to create more accurate and meaningful test cases.
=head3 Example Advanced Type Schema
For a method like:
sub process_event {
my ($self, $timestamp, $status, $callback) = @_;
croak unless $timestamp > 1000000000;
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
$self->_log(" CODE: $param inferred as number (numeric comparison)");
}
}
}
# --------------------------------------------------
# _analyze_advanced_types
#
# Purpose: Apply enhanced type detection to a
# single parameter, checking for
# DateTime objects, file handles,
# coderefs, and enum-like constraints
# beyond what basic type inference
# can determine.
#
# Entry: $p_ref - reference to the parameter
# hashref (modified in place
# via the referenced hash).
# $param - the parameter name string.
# $code - method body source string.
#
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# Now pass the dereferenced hash to the detection methods
$self->_detect_datetime_type($p, $param, $code);
$self->_detect_filehandle_type($p, $param, $code);
$self->_detect_coderef_type($p, $param, $code);
$self->_detect_enum_type($p, $param, $code);
}
# --------------------------------------------------
# _detect_datetime_type
#
# Purpose: Detect DateTime objects, Time::Piece
# objects, date strings, ISO 8601
# strings, and UNIX timestamps by
# analysing code patterns involving
# the parameter.
#
# Entry: $p - parameter hashref (modified
# in place).
# $param - parameter name string.
# $code - method body source string.
#
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
#
# Side effects: Logs detections to stdout when
# verbose is set.
# --------------------------------------------------
sub _detect_datetime_type {
my ($self, $p, $param, $code) = @_;
# Validate param is just a simple word
return unless defined $param && $param =~ /^\w+$/;
# DateTime object detection via isa/UNIVERSAL checks
if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]DateTime['"]\s*\)/i) {
$p->{type} = 'object';
$p->{isa} = 'DateTime';
$p->{semantic} = 'datetime_object';
$self->_log(" ADVANCED: $param is DateTime object");
return;
}
# Check for DateTime method calls
if ($code =~ /\$$param\s*->\s*(ymd|dmy|mdy|hms|iso8601|epoch|strftime)/) {
$p->{type} = 'object';
$p->{isa} = 'DateTime';
$p->{semantic} = 'datetime_object';
$self->_log(" ADVANCED: $param uses DateTime methods");
return;
}
# Time::Piece detection
if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]Time::Piece['"]\s*\)/i ||
$code =~ /\$$param\s*->\s*(strftime|epoch|year|mon|mday)/) {
$p->{type} = 'object';
$p->{isa} = 'Time::Piece';
$p->{semantic} = 'timepiece_object';
$self->_log(" ADVANCED: $param is Time::Piece object");
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
$code =~ /\$$param\s*-\s*time\(\s*\)/) {
$p->{type} = 'integer';
$p->{semantic} = 'unix_timestamp';
$p->{min} = 0;
$self->_log(" ADVANCED: $param appears to be UNIX timestamp");
return;
}
# Date parsing with strptime or similar
if ($code =~ /strptime\s*\(\s*\$$param/ ||
$code =~ /DateTime::Format::\w+\s*->\s*parse_datetime\s*\(\s*\$$param/) {
$p->{type} = 'string';
$p->{semantic} = 'datetime_parseable';
$self->_log(" ADVANCED: $param is parsed as datetime");
return;
}
}
# --------------------------------------------------
# _detect_filehandle_type
#
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
my $p = $schema->{input}{$param_name};
if ($p->{type} && $p->{type} eq 'coderef') {
push @warnings, "Parameter '$param_name' is a coderef - you'll need to provide a sub {} in tests";
}
if ($p->{semantic} && $p->{semantic} eq 'filehandle') {
push @warnings, "Parameter '$param_name' is a filehandle - consider using IO::String or mock";
}
if ($p->{isa} && $p->{isa} =~ /DateTime/) {
push @warnings, "Parameter '$param_name' requires DateTime - ensure DateTime is loaded";
}
}
}
if (@warnings) {
push @comments, '#';
push @comments, '# WARNINGS - Manual test setup may be required:';
foreach my $warning (@warnings) {
push @comments, "# ! $warning";
}
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
my %cleaned;
# Copy basic fields that App::Test::Generator expects
foreach my $field (qw(type position optional min max matches default)) {
$cleaned{$field} = $param->{$field} if defined $param->{$field};
}
# Handle advanced type mappings
if(my $semantic = $param->{semantic}) {
if ($semantic eq 'datetime_object') {
# DateTime objects: test generator needs to know how to create them
$cleaned{type} = 'object';
$cleaned{isa} = $param->{isa} || 'DateTime';
$cleaned{_note} = 'Requires DateTime object';
} elsif ($semantic eq 'timepiece_object') {
$cleaned{type} = 'object';
$cleaned{isa} = $param->{isa} || 'Time::Piece';
$cleaned{_note} = 'Requires Time::Piece object';
} elsif ($semantic eq 'date_string') {
# Date strings: provide regex pattern
$cleaned{type} = 'string';
$cleaned{matches} ||= '/^\d{4}-\d{2}-\d{2}$/';
$cleaned{_example} = '2024-12-12';
} elsif ($semantic eq 'iso8601_string') {
t/SchemaExtractor_function.t view on Meta::CPAN
if($mode eq 'read') { } elsif($mode eq 'write') { } elsif($mode eq 'append') { }
};
$e->_detect_enum_type(\%p, 'mode', $code);
is($p{semantic}, 'enum', 'enum from if/elsif chain');
};
# ==================================================================
# _detect_datetime_type
# ==================================================================
subtest '_detect_datetime_type() detects DateTime from isa check' => sub {
my $e = _extractor();
my %p;
$e->_detect_datetime_type(\%p, 'dt', 'sub foo { $dt->isa("DateTime"); }');
is($p{type}, 'object', 'object type set');
is($p{isa}, 'DateTime', 'DateTime isa set');
is($p{semantic}, 'datetime_object', 'datetime_object semantic');
};
subtest '_detect_datetime_type() detects UNIX timestamp from numeric range' => sub {
my $e = _extractor();
my %p;
$e->_detect_datetime_type(\%p, 'ts', 'sub foo { die if $ts > 9999999999; }');
is($p{type}, 'integer', 'integer type for timestamp');
is($p{semantic}, 'unix_timestamp', 'unix_timestamp semantic');
};
t/advanced_types.t view on Meta::CPAN
print $fh <<'END_MODULE';
package AdvancedTypes;
use strict;
use warnings;
use Carp qw(croak);
=head2 datetime_object($dt)
Parameters:
$dt - DateTime object
=cut
sub datetime_object {
my ($self, $dt) = @_;
croak unless $dt->isa('DateTime');
return $dt->ymd;
}
=head2 timepiece_object($tp)
Parameters:
$tp - Time::Piece object
=cut
t/advanced_types.t view on Meta::CPAN
=head2 datetime_parser($date_str)
Parameters:
$date_str - string, parseable date
=cut
sub datetime_parser {
my ($self, $date_str) = @_;
use DateTime::Format::Strptime;
my $parser = DateTime::Format::Strptime->new(pattern => '%Y-%m-%d');
return $parser->parse_datetime($date_str);
}
sub _private_advanced {
my ($self) = @_;
return 1;
}
1;
END_MODULE
t/advanced_types.t view on Meta::CPAN
# Extract schemas
my $schemas = $extractor->extract_all();
ok($schemas, 'extract_all returns schemas');
is(ref($schemas), 'HASH', 'schemas is a hashref');
# Check we found methods (excludes private)
my @methods = keys %$schemas;
cmp_ok(scalar(@methods), '>=', 15, 'Found at least 15 methods');
# DateTime object detection
subtest 'datetime_object method' => sub {
my $schema = $schemas->{datetime_object};
ok($schema, 'datetime_object schema exists');
my $dt_param = $schema->{input}{dt};
ok($dt_param, 'dt parameter detected');
# POD parser sets type to 'datetime' from the description, then code analysis enhances it
ok($dt_param->{type}, 'has a type');
is($dt_param->{isa}, 'DateTime', 'class is DateTime');
is($dt_param->{semantic}, 'datetime_object', 'semantic type is datetime_object');
};
# Time::Piece object detection
subtest 'timepiece_object method' => sub {
my $schema = $schemas->{timepiece_object};
ok($schema, 'timepiece_object schema exists');
my $tp_param = $schema->{input}{tp};
ok($tp_param, 'tp parameter detected');
# POD parser may set type to 'time' from description
ok($tp_param->{type}, 'has a type');
# But class should be detected from code
ok($tp_param->{isa}, 'has a class');
like($tp_param->{isa}, qr/Time::Piece|DateTime/, 'class is Time::Piece or DateTime');
ok($tp_param->{semantic}, 'has semantic type');
};
# Date string pattern detection
subtest 'date_string method' => sub {
my $schema = $schemas->{date_string};
ok($schema, 'date_string schema exists');
my $date_param = $schema->{input}{date};
ok($date_param, 'date parameter detected');
t/advanced_types.t view on Meta::CPAN
my $schema = $schemas->{file_operations};
ok($schema, 'file_operations schema exists');
my $filename_param = $schema->{input}{filename};
ok($filename_param, 'filename parameter detected');
is($filename_param->{type}, 'string', 'type is string');
ok($filename_param->{semantic}, 'has semantic type');
like($filename_param->{semantic}, qr/path|filepath/, 'semantic indicates path');
};
# DateTime parser detection
subtest 'datetime_parser method' => sub {
my $schema = $schemas->{datetime_parser};
ok($schema, 'datetime_parser schema exists');
my $date_str_param = $schema->{input}{date_str};
ok($date_str_param, 'date_str parameter detected');
is($date_str_param->{type}, 'string', 'type is string');
SKIP: {
skip 'DateTime parser detection may not work with module reference', 1 unless $date_str_param->{semantic};
is($date_str_param->{semantic}, 'datetime_parseable', 'semantic type is datetime_parseable');
}
};
# private methods excluded
ok(!exists($schemas->{_private_advanced}), 'private methods excluded');
# YAML files written with advanced types
my $schema_dir = File::Spec->catdir($tempdir, 'schemas');
t/advanced_types.t view on Meta::CPAN
open my $yaml_fh, '<', $enum_yaml or die "Can't read YAML: $!";
my $yaml_content = do { local $/; <$yaml_fh> };
close $yaml_fh;
like($yaml_content, qr/function:\s*enum_validation/, 'YAML contains method name');
like($yaml_content, qr/type:\s*string/, 'YAML contains type');
like($yaml_content, qr/enum:/, 'YAML contains enum field');
like($yaml_content, qr/active/, 'YAML contains enum value');
# Check YAML content for DateTime
my $dt_yaml = File::Spec->catfile($schema_dir, 'datetime_object.yml');
ok(-f $dt_yaml, 'datetime_object.yml file created');
open $yaml_fh, '<', $dt_yaml or die "Can't read YAML: $!";
$yaml_content = do { local $/; <$yaml_fh> };
close $yaml_fh;
like($yaml_content, qr/isa:\s*DateTime/, 'YAML contains DateTime class');
like($yaml_content, qr/Parameter types detected:/, 'YAML contains parameter notes');
# Check YAML content for coderef
my $callback_yaml = File::Spec->catfile($schema_dir, 'callback_sub.yml');
ok(-f $callback_yaml, 'callback_sub.yml file created');
open $yaml_fh, '<', $callback_yaml or die "Can't read YAML: $!";
$yaml_content = do { local $/; <$yaml_fh> };
close $yaml_fh;
t/advanced_types.t view on Meta::CPAN
__END__
=head1 NAME
advanced_types.t - Test suite for Advanced Type Detection
=head1 DESCRIPTION
Tests the advanced type detection functionality including:
- DateTime and Time::Piece object detection
- Date/time string patterns (ISO 8601, date strings, Unix timestamps)
- File handle and file path detection
- Coderef/callback detection
- Enum detection (regex, hash lookup, grep, if/elsif chains)
- YAML serialization of advanced types
- Comment generation with warnings
This test ensures that the schema extractor can identify and properly
serialize advanced Perl types that go beyond simple strings and integers.
( run in 2.133 seconds using v1.01-cache-2.11-cpan-e93a5daba3e )