App-Test-Generator

 view release on metacpan or  search on metacpan

lib/App/Test/Generator.pm  view on Meta::CPAN

  # This is a long way away yet, but see t/schema_input.t for a proof of concept
  my $extractor = App::Test::Generator::SchemaExtractor->new(
    input_file => 'Foo.pm',
    output_dir => $dir
  );
  my $schemas = $extractor->extract_all();
  foreach my $schema(keys %{$schemas}) {
    my $tempfile = '/var/tmp/foo.t';	# Use File::Temp in real life
    App::Test::Generator->generate(
      schema => $schemas->{$schema},
      output_file => $tempfile,
    );
    system("$^X -I$dir $tempfile");
    unlink $tempfile;
  }

=head1 OVERVIEW

This module takes a formal input/output specification for a routine or
method and automatically generates test cases. In effect, it allows you
to easily add comprehensive black-box tests in addition to the more
common white-box tests that are typically written for CPAN modules and other
subroutines.

The generated tests combine:

=over 4

=item * Random fuzzing based on input types

=item * Deterministic edge cases for min/max constraints

=item * Static corpus tests defined in Perl or YAML

=back

This approach strengthens your test suite by probing both expected and
unexpected inputs, helping you to catch boundary errors, invalid data
handling, and regressions without manually writing every case.

=head1 DESCRIPTION

This module implements the logic behind L<fuzz-harness-generator>.
It parses configuration files (fuzz and/or corpus YAML), and
produces a ready-to-run F<.t> test script to run through C<prove>.

It reads configuration files in any format,
and optional YAML corpus files.
All of the examples in this documentation are in C<YAML> format,
other formats may not work as they aren't so heavily tested.
It then generates a L<Test::Most>-based fuzzing harness combining:

=over 4

=item * Randomized fuzzing of inputs (with edge cases)

=item * Optional static corpus tests from Perl C<%cases> or YAML file (C<yaml_cases> key)

=item * Functional or OO mode (via C<$new>)

=item * Reproducible runs via C<$seed> and configurable iterations via C<$iterations>

=back

=head1 MUTATION-GUIDED TEST GENERATION

C<App::Test::Generator> includes a pipeline that automatically closes the
feedback loop between mutation testing, schema extraction, and fuzz
testing. The goal is that surviving mutants drive the creation of new
tests that kill them on the next run, without manual intervention.

=head2 The Pipeline

    mutation survivor
        |
        v
    SchemaExtractor extracts the schema for the enclosing sub
        |
        v
    Schema augmented with boundary values from the mutant
        |
        v
    Augmented schema written to t/conf/
        |
        v
    t/fuzz.t picks up the new schema and runs fuzz tests
        |
        v
    Mutation killed on next run

=head2 How to Use It

The pipeline is driven by three flags passed to
C<bin/test-generator-index>, which is invoked automatically by
C<bin/generate-test-dashboard> on each CI push.

=head3 Step 1: Generate TODO stubs for all survivors

    bin/test-generator-index --generate_mutant_tests=t

Produces C<t/mutant_YYYYMMDD_HHMMSS.t> containing:

=over 4

=item * TODO stubs for HIGH and MEDIUM difficulty survivors, with
boundary value suggestions, environment variable hints, and the
enclosing subroutine name for navigation context.

=item * Comment-only hints for LOW difficulty survivors.

=back

Multiple mutations on the same source line are deduplicated into one
stub. One good test kills all variants on that line.

=head3 Step 2: Generate runnable schemas for NUM_BOUNDARY survivors

    bin/test-generator-index \
        --generate_mutant_tests=t \
        --generate_test=mutant

lib/App/Test/Generator.pm  view on Meta::CPAN

    preserves_zero:
      input:
        value:
          type: number
          value: 0
      output:
        type: number
        value: 0

=head3 C<$module>

The name of the module (optional).

Using the reserved word C<builtin> means you're testing a Perl builtin function.

If omitted, the generator will guess from the config filename:
C<My-Widget.conf> -> C<My::Widget>.

=head3 C<$function>

The function/method to test.

This defaults to C<run>.

=head3 C<%new>

An optional hashref of args to pass to the module's constructor.

  new:
    api_key: ABC123
    verbose: true

To ensure C<new()> is called with no arguments, you still need to define new, thus:

  module: MyModule
  function: my_function

  new:

=head3 C<%cases>

An optional Perl static corpus, when the output is a simple string (expected => [ args... ]).

Maps the expected output string to the input and _STATUS

  cases:
    ok:
      input: ping
      _STATUS: OK
    error:
      input: ""
      _STATUS: DIES

=head3 C<$yaml_cases> - optional path to a YAML file with the same shape as C<%cases>.

=head3 C<$seed>

An optional integer.
When provided, the generated C<t/fuzz.t> will call C<srand($seed)> so fuzz runs are reproducible.

=head3 C<$iterations>

An optional integer controlling how many fuzz iterations to perform (default 30).

=head3 C<%edge_cases>

An optional hash mapping of extra values to inject.

	# Two named parameters
	edge_cases:
		name: [ '', 'a' x 1024, \"\x{263A}" ]
		age: [ -1, 0, 99999999 ]

	# Takes a string input
	edge_cases: [ 'foo', 'bar' ]

Values can be strings or numbers; strings will be properly quoted.
Note that this only works with routines that take named parameters.

=head3 C<%type_edge_cases>

An optional hash mapping types to arrayrefs of extra values to try for any field of that type:

	type_edge_cases:
		string: [ '', ' ', "\t", "\n", "\0", 'long' x 1024, chr(0x1F600) ]
		number: [ 0, 1.0, -1.0, 1e308, -1e308, 1e-308, -1e-308, 'NaN', 'Infinity' ]
		integer: [ 0, 1, -1, 2**31-1, -(2**31), 2**63-1, -(2**63) ]

=head3 C<%edge_case_array>

Specify edge case values for routines that accept a single unnamed parameter.
This is specifically designed for simple functions that take one argument without a parameter name.
These edge cases supplement the normal random string generation, ensuring specific problematic values are always tested.
During fuzzing iterations, there's a 40% probability that a test case will use a value from edge_case_array instead of randomly generated data.

  ---
  module: Text::Processor
  function: sanitize

  input:
    type: string
    min: 1
    max: 1000

  edge_case_array:
    - "<script>alert('xss')</script>"
    - "'; DROP TABLE users; --"
    - "\0null\0byte"
    - "emoji😊test"
    - ""
    - " "

  seed: 42
  iterations: 30

=head3 Semantic Data Generators

For property-based testing with L<Test::LectroTest>,
you can use semantic generators to create realistic test data.

C<unix_timestamp> is currently fully supported,
other fuzz testing support for C<semantic> entries is being developed.

  input:
    email:
      type: string
      semantic: email

    user_id:
      type: string
      semantic: uuid

    phone:
      type: string
      semantic: phone_us

=head4 Available Semantic Types

=over 4

=item * C<email> - Valid email addresses (user@domain.tld)

=item * C<url> - HTTP/HTTPS URLs

=item * C<uuid> - UUIDv4 identifiers

=item * C<phone_us> - US phone numbers (XXX-XXX-XXXX)

=item * C<phone_e164> - International E.164 format (+XXXXXXXXXXXX)

=item * C<ipv4> - IPv4 addresses (0.0.0.0 - 255.255.255.255)

=item * C<ipv6> - IPv6 addresses

=item * C<username> - Alphanumeric usernames with _ and -

=item * C<slug> - URL slugs (lowercase-with-hyphens)

=item * C<hex_color> - Hex color codes (#RRGGBB)

=item * C<iso_date> - ISO 8601 dates (YYYY-MM-DD)

=item * C<iso_datetime> - ISO 8601 datetimes (YYYY-MM-DDTHH:MM:SSZ)

=item * C<semver> - Semantic version strings (major.minor.patch)

=item * C<jwt> - JWT-like tokens (base64url format)

=item * C<json> - Simple JSON objects

=item * C<base64> - Base64-encoded strings

=item * C<md5> - MD5 hashes (32 hex chars)

lib/App/Test/Generator.pm  view on Meta::CPAN

  function: abs

  config:
    test_undef: no
    test_empty: no
    test_nuls: no
    properties:
      enable: true
      trials: 1000

  input:
    number:
      type: number
      position: 0

  output:
    type: number
    min: 0

  transforms:
    positive:
      input:
        number:
          type: number
          min: 0
      output:
        type: number
        min: 0

    negative:
      input:
        number:
          type: number
          max: 0
      output:
        type: number
        min: 0

This configuration:

=over 4

=item * Enables property-based testing with 1000 trials per property

=item * Defines two transforms: one for positive numbers, one for negative

=item * Automatically generates properties that verify C<abs()> always returns non-negative numbers

=back

Generate the test:

  fuzz-harness-generator t/conf/abs.yml > t/abs_property.t

The generated test will include:

=over 4

=item * Traditional edge-case tests for boundary conditions

=item * Random fuzzing with 30 iterations (or as configured)

=item * Property-based tests that verify the transforms with 1000 trials each

=back

=head3 What Properties Are Tested?

The generator automatically detects and tests these properties based on your transform specifications:

=over 4

=item * B<Range constraints> - If output has C<min> or C<max>, verifies results stay within bounds

=item * B<Type preservation> - Ensures numeric inputs produce numeric outputs

=item * B<Definedness> - Verifies the function doesn't return C<undef> unexpectedly

=item * B<Specific values> - If output specifies a C<value>, checks exact equality

=back

For the C<abs> example above, the generated properties verify:

  # For the "positive" transform:
  - Given a positive number, abs() returns >= 0
  - The result is a valid number
  - The result is defined

  # For the "negative" transform:
  - Given a negative number, abs() returns >= 0
  - The result is a valid number
  - The result is defined

=head3 Advanced Example: String Normalization

Here's a more complex example testing a string normalization function:

B<t/conf/normalize.yml>:

  ---
  module: Text::Processor
  function: normalize_whitespace

  config:
    properties:
      enable: true
      trials: 500

  input:
    text:
      type: string
      min: 0
      max: 1000
      position: 0

  output:
    type: string
    min: 0
    max: 1000

lib/App/Test/Generator.pm  view on Meta::CPAN

          matches: '^\S+(\s+\S+)*$'
      output:
        type: string
        matches: '^\S+( \S+)*$'

    length_bounded:
      input:
        text:
          type: string
          min: 1
          max: 100
      output:
        type: string
        min: 1
        max: 100

This tests that the normalization function:

=over 4

=item * Preserves empty strings (C<empty_preserved> transform)

=item * Collapses multiple spaces into single spaces (C<single_space> transform)

=item * Maintains length constraints (C<length_bounded> transform)

=back

=head3 Interpreting Property Test Results

When property-based tests run, you'll see output like:

  ok 123 - negative property holds (1000 trials)
  ok 124 - positive property holds (1000 trials)

If a property fails, Test::LectroTest will attempt to find the minimal failing
case and display it:

  not ok 123 - positive property holds (47 trials)
  # Property failed
  # Reason: counterexample found

This helps you quickly identify edge cases that your function doesn't handle correctly.

=head3 Configuration Options for Property-Based Testing

In the C<config> section:

  config:
    properties:
      enable: true     # Enable property-based testing (default: false)
      trials: 1000     # Number of test cases per property (default: 1000)

You can also disable traditional fuzzing and only use property-based tests:

  config:
    properties:
      enable: true
      trials: 5000

  iterations: 0  # Disable random fuzzing, use only property tests

=head3 When to Use Property-Based Testing

Property-based testing with transforms is particularly useful for:

=over 4

=item * Mathematical functions (C<abs>, C<sqrt>, C<min>, C<max>, etc.)

=item * Data transformations (encoding, normalization, sanitization)

=item * Parsers and formatters

=item * Functions with clear input-output relationships

=item * Code that should satisfy mathematical properties (commutativity, associativity, idempotence)

=back

=head3 Requirements

Property-based testing requires L<Test::LectroTest> to be installed:

  cpanm Test::LectroTest

If not installed, the generated tests will automatically skip the property-based
portion with a message.

=head3 Testing Email Validation

  ---
  module: Email::Valid
  function: rfc822

  config:
    properties:
      enable: true
      trials: 200
    close_stdin: true
    test_undef: no
    test_empty: no
    test_nuls: no

  input:
    email:
      type: string
      semantic: email
      position: 0

  output:
    type: boolean

  transforms:
    valid_emails:
      input:
        email:
          type: string
          semantic: email
      output:
        type: boolean

lib/App/Test/Generator.pm  view on Meta::CPAN

      input:
        text:
          type: string
      output:
        type: string
      properties:
        - name: single_spaces
          description: "No multiple consecutive spaces"
          code: $result !~ /  /

        - name: no_leading_space
          description: "No space at start"
          code: $result !~ /^\s/

        - name: reversible
          description: "Can be reversed back"
          code: length($result) == length($text)

The code has access to:

=over 4

=item * C<$result> - The function's return value

=item * Input variables - All input parameters (e.g., C<$text>, C<$number>)

=item * The function itself - Can call it again for idempotence checks

=back

=head4 Combining Auto-detected and Custom Properties

The generator automatically detects properties from your output spec, and adds
your custom properties:

  transforms:
    sanitize:
      input:
        html:
          type: string
      output:
        type: string
        min: 0              # Auto-detects: defined, min_length >= 0
        max: 10000
      properties:           # Additional custom checks:
        - name: no_scripts
          code: $result !~ /<script/i
        - name: no_iframes
          code: $result !~ /<iframe/i

=head2 GENERATED OUTPUT

The generated test:

=over 4

=item * Seeds RND (if configured) for reproducible fuzz runs

=item * Uses edge cases (per-field and per-type) with configurable probability

=item * Runs C<$iterations> fuzz cases plus appended edge-case runs

=item * Validates inputs with Params::Get / Params::Validate::Strict

=item * Validates outputs with L<Return::Set>

=item * Runs static C<is(... )> corpus tests from Perl and/or YAML corpus

=item * Runs L<Test::LectroTest> tests

=back

=cut

=head1 METHODS

=head2 generate

Takes a schema file and produces a test file (or STDOUT).

  # Modern named API
  App::Test::Generator->generate(
      schema_file => 'schemas/foo.yml',
      output_file => 'test/foo.t',
  );

  # Legacy positional API
  App::Test::Generator->generate($schema_file, $test_file);

=head3 API Specification

=head4 Input

    {
        schema_file => { type => 'string', optional => 1 },
        input_file  => { type => 'string', optional => 1 },
        output_file => { type => 'string', optional => 1 },
        schema      => { type => 'hashref', optional => 1 },
        quiet       => { type => 'boolean', optional => 1 },
    }

=head4 Output

    { type => 'string' }

=cut

sub generate
{
	croak 'Usage: generate(schema_file [, outfile])' if(scalar(@_) == 0);

	# Accept both class-method call (App::Test::Generator->generate(...))
	# and plain-function call with a hashref (generate({...})).
	# In the method form the first arg is the class name (a plain string);
	# in the function form with a hashref the first arg IS the hashref.
	my $class = (ref($_[0]) ne 'HASH') ? shift : undef;
	my ($schema_file, $test_file, $schema);
	# Globals loaded from the user's conf (all optional except function maybe)
	my ($module, $function, $new, $yaml_cases);
	my ($seed, $iterations);

	if((ref($_[0]) eq 'HASH') || defined($_[2])) {
		# Modern API
		my $params = Params::Validate::Strict::validate_strict({
			args => Params::Get::get_params(undef, \@_),
			schema => {
				input_file => { type => 'string', optional => 1 },
				schema_file => { type => 'string', optional => 1 },
				output_file => { type => 'string', optional => 1 },
				schema => { type => 'hashref', optional => 1 },
				quiet => { type => 'boolean', optional => 1 },	# Not yet used
			}
		});
		if($params->{'schema_file'}) {
			$schema_file = $params->{'schema_file'};
		} elsif($params->{'input_file'}) {
			$schema_file = $params->{'input_file'};
		} elsif($params->{'schema'}) {
			$schema = $params->{'schema'};
		} else {
			croak(__PACKAGE__, ': Usage: generate(input_file|schema [, output_file]');
		}
		if(defined($schema_file)) {
			$schema = _load_schema($schema_file);
		}
		$test_file = $params->{'output_file'};
	} else {
		# Legacy API
		($schema_file, $test_file) = @_;
		if(defined($schema_file)) {
			$schema = _load_schema($schema_file);
		} else {
			croak 'Usage: generate(schema_file [, outfile])';
		}
	}

	# Parse the schema file and load into our structures
	my %input = %{_load_schema_section($schema, 'input', $schema_file)};
	my %output = %{_load_schema_section($schema, 'output', $schema_file)};
	my %transforms = %{_load_schema_section($schema, 'transforms', $schema_file)};
	my %accessor = %{_load_schema_section($schema, 'accessor', $schema_file)};

	my %cases = %{$schema->{cases}} if(exists($schema->{cases}));
	my %edge_cases = %{$schema->{edge_cases}} if(exists($schema->{edge_cases}));
	my %type_edge_cases = %{$schema->{type_edge_cases}} if(exists($schema->{type_edge_cases}));

	$module = $schema->{module} if(exists($schema->{module}) && length($schema->{module}));
	$function = $schema->{function} if(exists($schema->{function}));
	if(exists($schema->{new})) {
		$new = defined($schema->{'new'}) ? $schema->{new} : '_UNDEF';
	}
	$yaml_cases = $schema->{yaml_cases} if(exists($schema->{yaml_cases}));
	$seed = $schema->{seed} if(exists($schema->{seed}));
	$iterations = $schema->{iterations} if(exists($schema->{iterations}));

	my @edge_case_array = @{$schema->{edge_case_array}} if(exists($schema->{edge_case_array}));
	_validate_config($schema);

	my %config = %{$schema->{config}} if(exists($schema->{config}));

	_normalize_config(\%config);

	# Guess module name from config file if not set
	if(!$module) {
		if($schema_file) {
			($module = basename($schema_file)) =~ s/\.(conf|pl|pm|yml|yaml)$//;
			$module =~ s/-/::/g;
			# Guard against Perl builtin function names being mistaken
			# for module names — builtins have no module to load
			if(_is_perl_builtin($module)) {
				undef $module;
			}
		}
	} elsif($module eq $MODULE_BUILTIN) {
		undef $module;
	}

	if($module && length($module) && ($module ne 'builtin')) {
		_validate_module($module, $schema_file);
	}

	# sensible defaults
	$function ||= 'run';
	$iterations ||= DEFAULT_ITERATIONS;		 # default fuzz runs if not specified
	$seed = undef if defined $seed && $seed eq '';	# treat empty as undef

	# --- YAML corpus support (yaml_cases is filename string) ---
	my %yaml_corpus_data;
	if (defined $yaml_cases) {
		croak("$yaml_cases: $!") if(!-f $yaml_cases);

		my $yaml_data = LoadFile(Encode::decode('utf8', $yaml_cases));
		if ($yaml_data && ref($yaml_data) eq 'HASH') {
			# Validate that the corpus inputs are arrayrefs
			# e.g: "FooBar": 	["foo_bar"]
			# Skip only invalid entries:
			for my $expected (keys %{$yaml_data}) {
				my $outputs = $yaml_data->{$expected};
				unless($outputs && (ref $outputs eq 'ARRAY')) {
					carp("$yaml_cases: $expected does not point to an array ref, ignoring");
					next;
				}
				$yaml_corpus_data{$expected} = $outputs;
			}
		}
	}

	# Merge Perl %cases and YAML corpus safely
	# my %all_cases = (%cases, %yaml_corpus_data);
	my %all_cases = (%yaml_corpus_data, %cases);
	for my $k (keys %yaml_corpus_data) {
		if (exists $cases{$k} && ref($cases{$k}) eq 'ARRAY' && ref($yaml_corpus_data{$k}) eq 'ARRAY') {
			$all_cases{$k} = [ @{$yaml_corpus_data{$k}}, @{$cases{$k}} ];
		}
	}

	if(my $hints = delete $schema->{_yamltest_hints}) {
		if(my $boundaries = $hints->{boundary_values}) {
			push @edge_case_array, @{$boundaries};
		}
		if(my $invalid = $hints->{invalid}) {
			carp('TODO: handle yamltest_hints->invalid');
		}
	}

	# If the schema says the type is numeric, normalize
	if ($schema->{type} && $schema->{type} =~ /^(integer|number|float)$/) {
		for (@edge_case_array) {
			next unless defined $_;
			$_ += 0 if Scalar::Util::looks_like_number($_);
		}
	}

	# Load relationships from the schema if present and well-formed.
	# SchemaExtractor may set this to undef or an empty arrayref when
	# no relationships were detected, so guard both existence and type.
	my @relationships;
	if(exists($schema->{relationships}) && ref($schema->{relationships}) eq 'ARRAY') {
		@relationships = @{$schema->{relationships}};
	}

	# Serialise the relationships array from the schema into Perl source
	# code for embedding in the generated test file. Each relationship
	# type is rendered as a hashref in the @relationships array.

lib/App/Test/Generator.pm  view on Meta::CPAN

					$corpus_code .= "dies_ok { \$obj->$function($input_str) } " .
							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") dies';\n";
				} elsif($status eq 'WARNS') {
					$corpus_code .= "warnings_exist { \$obj->$function($input_str) } qr/./, " .
							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") warns';\n";
				} else {
					my $desc = sprintf("$function(%s) returns %s",
						perl_quote(join(', ', map { $_ // '' } @$inputs )),
						$expected_str
					);
					if(($output{'type'} // '') eq 'boolean') {
						if($expected_str eq '1') {
							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
						} elsif($expected_str eq '0') {
							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
						} else {
							croak("Boolean is expected to return $expected_str");
						}
					} else {
						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
					}
				}
			} else {
				if($status eq 'DIES') {
					if($module) {
						$corpus_code .= "dies_ok { $module\::$function($input_str) } " .
							"'Corpus $expected dies';\n";
					} else {
						$corpus_code .= "dies_ok { $function($input_str) } " .
							"'Corpus $expected dies';\n";
					}
				} elsif($status eq 'WARNS') {
					if($module) {
						$corpus_code .= "warnings_exist { $module\::$function($input_str) } qr/./, " .
							"'Corpus $expected warns';\n";
					} else {
						$corpus_code .= "warnings_exist { $function($input_str) } qr/./, " .
							"'Corpus $expected warns';\n";
					}
				} else {
					my $desc = sprintf("$function(%s) returns %s",
						perl_quote((ref $inputs eq 'ARRAY') ? (join(', ', map { $_ // '' } @{$inputs})) : $inputs),
						$expected_str
					);
					if(($output{'type'} // '') eq 'boolean') {
						if($expected_str eq '1') {
							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
						} elsif($expected_str eq '0') {
							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
						} else {
							croak("Boolean is expected to return $expected_str");
						}
					} else {
						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
					}
				}
			}
		}
	}

	# Prepare seed/iterations code fragment for the generated test
	my $seed_code = '';
	if (defined $seed) {
		# ensure integer-ish
		$seed = int($seed);
		$seed_code = "srand($seed);\n";
	}

	my $determinism_code = 'my $result2;' .
		'eval { $result2 = do { ' . (defined($position_code) ? $position_code : $call_code) . " }; };\n" .
		'is_deeply($result2, $result, "deterministic result for same input");' .
		"\n";

	# Generate the test content
	my $tt = Template->new({ ENCODING => 'utf8', TRIM => 1 });

	# Read template from DATA handle
	my $template_package = __PACKAGE__ . '::Template';
	my $template = $template_package->get_data_section('test.tt');

	my $vars = {
		setup_code => $setup_code,
		edge_cases_code => $edge_cases_code,
		edge_case_array_code => $edge_case_array_code,
		type_edge_cases_code => $type_edge_cases_code,
		config_code => $config_code,
		seed_code => $seed_code,
		input_code => $input_code,
		output_code => $output_code,
		transforms_code => $transforms_code,
		corpus_code => $corpus_code,
		call_code => $call_code,
		position_code => $position_code,
		determinism_code => $determinism_code,
		function => $function,
		iterations_code => int($iterations),
		use_properties => $use_properties,
		transform_properties_code => $transform_properties_code,
		property_trials => $config{properties}{trials} // DEFAULT_PROPERTY_TRIALS,
		relationships_code => $relationships_code,
		module => $module
	};

	my $test;
	$tt->process($template, $vars, \$test) or croak($tt->error());

	if ($test_file) {
		open my $fh, '>:encoding(UTF-8)', $test_file or croak "Cannot open $test_file: $!";
		print $fh "$test\n";
		close $fh;
		if($module) {
			print "Generated $test_file for $module\::$function with fuzzing + corpus support\n";
		} else {
			print "Generated $test_file for $function with fuzzing + corpus support\n";
		}
	} else {
		print "$test\n";
	}
}

# --- Helpers for rendering data structures into Perl code for the generated test ---

# --------------------------------------------------
# _is_perl_builtin
#
# Purpose:    Return true if a string is the name of
#             a Perl core builtin function, to prevent
#             it being used as a module name in
#             use_ok() calls in generated tests.
#
# Entry:      $name - the string to check.
# Exit:       Returns 1 if builtin, 0 otherwise.
# Side effects: None.
# --------------------------------------------------
sub _is_perl_builtin {
	my $name = $_[0];
	return 0 unless defined $name;

	state %BUILTINS = map { $_ => 1 } qw(
		abs accept alarm atan2 bind binmode bless
		caller chdir chmod chomp chop chown chr chroot
		close closedir connect cos crypt
		dbmclose dbmopen defined delete die do dump
		each endgrent endhostent endnetent endprotoent endpwent endservent
		eof eval exec exists exit exp
		fcntl fileno flock fork format formline
		getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname
		gethostent getlogin getnetbyaddr getnetbyname getnetent
		getpeername getpgrp getppid getpriority getprotobyname
		getprotobynumber getprotoent getpwent getpwnam getpwuid
		getservbyname getservbyport getservent getsockname getsockopt
		glob gmtime goto grep
		hex
		index int ioctl
		join
		keys kill

lib/App/Test/Generator.pm  view on Meta::CPAN

			}

			# Build the call expression for the builtin template.
			# $new here is the raw OO signal from the caller —
			# defined means OO mode, undef means functional
			my $call_code;
			if($module && defined($new)) {
				# OO mode — fresh object per trial
				$call_code  = "my \$obj = new_ok('$module');";
				$call_code .= "\$obj->$function";
			} elsif($module && $module ne $MODULE_BUILTIN) {
				# Functional mode with a named module
				$call_code = "$module\::$function";
			} else {
				# Builtin or unqualified function call
				$call_code = $function;
			}
			$call_code .= '(' . join(', ', @args) . ')';

			# Instantiate the builtin's code template with the
			# call expression and input variable list
			$prop_code = $builtin->{'code_template'}->($function, $call_code, \@var_names);
			$prop_desc = $builtin->{'description'};

		} elsif(ref($prop_def) eq 'HASH') {
			# Hashref — custom property with inline Perl code
			$prop_name = $prop_def->{'name'} || 'custom_property';
			$prop_code = $prop_def->{'code'};
			$prop_desc = $prop_def->{'description'} || "Custom property: $prop_name";

			unless($prop_code) {
				carp "Custom property '$prop_name' missing 'code' field, skipping";
				next;
			}

			# Sanity-check: code must contain at least a variable
			# reference or a word character to be meaningful
			unless($prop_code =~ /\$/ || $prop_code =~ /\w+/) {
				carp "Custom property '$prop_name' code looks invalid: $prop_code";
				next;
			}

		} else {
			# Neither string nor hashref — unrecognised definition type
			carp 'Invalid property definition: ', render_fallback($prop_def);
			next;
		}

		push @properties, {
			name        => $prop_name,
			code        => $prop_code,
			description => $prop_desc,
		};
	}

	return @properties;
}

=head1 NOTES

C<seed> and C<iterations> really should be within C<config>.

=head1 SEE ALSO

=over 4

=item * L<Test Coverage Report|https://nigelhorne.github.io/App-Test-Generator/coverage/>

=item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>

=item * L<App::Test::Generator::SchemaExtractor> - Create schemas from Perl programs

=item * L<Params::Validate::Strict>: Schema Definition

=item * L<Params::Get>: Input validation

=item * L<Return::Set>: Output validation

=item * L<Test::LectroTest>

=item * L<Test::Most>

=item * L<YAML::XS>

=back

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

Portions of this module's initial design and documentation were created with the
assistance of AI.

=head1 SUPPORT

This module is provided as-is without any warranty.

You can find documentation for this module with the perldoc command.

    perldoc App::Test::Generator

You can also look for information at:

=over 4

=item * MetaCPAN

L<https://metacpan.org/release/App-Test-Generator>

=item * GitHub

L<https://github.com/nigelhorne/App-Test-Generator>

=item * CPANTS

L<http://cpants.cpanauthors.org/dist/App-Test-Generator>

=item * CPAN Testers' Matrix

L<http://matrix.cpantesters.org/?dist=App-Test-Generator>



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