App-Test-Generator

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

		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 0.938 second using v1.01-cache-2.11-cpan-e93a5daba3e )