lib/App/Test/Generator.pm

        start → end → jump
        

    1: package App::Test::Generator;
    2: 
    3: # TODO: Test validator from Params::Validate::Strict 0.16
    4: # TODO: $seed should be passed to Data::Random::String::Matches
    5: # TODO: positional args - when config_undef is set, see what happens when not all args are given
    6: # TODO: The Dup and TER1/2/3 columns should be moved from the Mutation table
    7: #	to a new table called Metrics.  Add Halstead and McCabes metrics to
    8: #	this new Metrics table.  Include links to the definitions of TER1/2/3,
    9: #	Halstead and McCabes metrics, perhaps from Wikipedia
   10: 
   11: use 5.036;
   12: 
   13: use strict;
   14: use warnings;
   15: use autodie qw(:all);
   16: 
   17: use utf8;
   18: use open qw(:std :encoding(UTF-8));
   19: 
   20: use App::Test::Generator::Template;
   21: use Carp qw(carp croak confess);
   22: use Config::Abstraction 0.36;
   23: use Data::Dumper;
   24: use Data::Section::Simple;
   25: use File::Basename qw(basename);
   26: use File::Spec;
   27: use Module::Load::Conditional qw(check_install can_load);
   28: use Params::Get;
   29: use Params::Validate::Strict 0.36;
   30: use Readonly;
   31: use Readonly::Values::Boolean;
   32: use Scalar::Util qw(looks_like_number);
   33: use re 'regexp_pattern';
   34: use Template;
   35: use YAML::XS qw(LoadFile);
   36: 
   37: use Exporter 'import';
   38: 
   39: our @EXPORT_OK = qw(generate);
   40: 
   41: our $VERSION = '0.46';
   42: 
   43: Readonly my $DEFAULT_ITERATIONS      => 30;
   44: Readonly my $DEFAULT_PROPERTY_TRIALS => 1000;
   45: 
   46: # Hash for O(1) lookup rather than a list needing grep O(n)
   47: Readonly my %VALID_CONFIG_KEYS => map { $_ => 1 } qw(
   48: 	test_nuls test_undef test_empty test_non_ascii
   49: 	dedup properties close_stdin test_security timeout
   50: );
   51: 
   52: # --------------------------------------------------
   53: # Delimiter pairs tried in order when wrapping a
   54: # string with q{} — bracket forms are preferred as
   55: # they are most readable in generated test code
   56: # --------------------------------------------------
   57: Readonly my @Q_BRACKET_PAIRS => (
   58: 	['{', '}'],
   59: 	['(', ')'],
   60: 	['[', ']'],
   61: 	['<', '>'],
   62: );
   63: 
   64: # --------------------------------------------------
   65: # Single-character delimiters tried when no bracket
   66: # pair is usable — each is tried in order and the
   67: # first one not present in the string is used.
   68: # The # character is last since it starts comments
   69: # in many contexts and is least readable
   70: # --------------------------------------------------
   71: Readonly my @Q_SINGLE_DELIMITERS => (
   72: 	'~', '!', '%', '^', '=', '+', ':', ',', ';', '|', '/', '#'
   73: );
   74: 
   75: # --------------------------------------------------
   76: # Sentinel returned by index() when the search
   77: # string is not found — used to make the >= 0
   78: # boundary check self-documenting and to prevent
   79: # NumericBoundary mutants from surviving
   80: # --------------------------------------------------
   81: Readonly my $INDEX_NOT_FOUND => -1;
   82: 
   83: # --------------------------------------------------
   84: # Readonly constants for schema validation
   85: # --------------------------------------------------
   86: Readonly my $CONFIG_PROPERTIES_KEY => 'properties';
   87: Readonly my $LEGACY_PERL_KEY_1     => '$module';
   88: Readonly my $LEGACY_PERL_KEY_2     => 'our $module';
   89: Readonly my $SOURCE_KEY            => '_source';
   90: 
   91: # --------------------------------------------------
   92: # Readonly constants for render_hash key detection
   93: # --------------------------------------------------
   94: Readonly my $KEY_MATCHES => 'matches';
   95: Readonly my $KEY_NOMATCH => 'nomatch';
   96: 
   97: # --------------------------------------------------
   98: # Reserved module name indicating a Perl builtin
   99: # function rather than a CPAN or user module
  100: # --------------------------------------------------
  101: Readonly my $MODULE_BUILTIN => 'builtin';
  102: 
  103: # --------------------------------------------------
  104: # Regex pattern matched against transform names to
  105: # detect the positive/non-negative idempotence
  106: # heuristic in _detect_transform_properties
  107: # --------------------------------------------------
  108: Readonly my $TRANSFORM_POSITIVE_PATTERN => 'positive';
  109: 
  110: # --------------------------------------------------
  111: # Default type assumed for schema fields that declare
  112: # no explicit type — used in generator selection and
  113: # dominant-type detection
  114: # --------------------------------------------------
  115: Readonly my $DEFAULT_FIELD_TYPE => 'string';
  116: 
  117: # --------------------------------------------------
  118: # Default range used by the LectroTest float/integer
  119: # generators when no min or max constraint is given.
  120: # Chosen to provide a useful spread without producing
  121: # values so large they overflow downstream arithmetic.
  122: # --------------------------------------------------
  123: Readonly my $DEFAULT_GENERATOR_RANGE => 1000;
  124: 
  125: # --------------------------------------------------
  126: # Default upper bound on the number of elements in
  127: # generated arrayrefs and hashrefs when no max is
  128: # declared in the schema.
  129: # --------------------------------------------------
  130: Readonly my $DEFAULT_MAX_COLLECTION_SIZE => 10;
  131: 
  132: # --------------------------------------------------
  133: # Default upper bound on generated string length
  134: # when no max is declared in the schema.
  135: # --------------------------------------------------
  136: Readonly my $DEFAULT_MAX_STRING_LEN => 100;
  137: 
  138: # --------------------------------------------------
  139: # Sentinel for the zero boundary used in float
  140: # generator selection — comparing min/max against
  141: # this constant makes the boundary intent explicit
  142: # and prevents NumericBoundary mutants from surviving.
  143: # --------------------------------------------------
  144: Readonly my $ZERO_BOUNDARY => 0;
  145: 
  146: # --------------------------------------------------
  147: # Environment variable names used to control verbose
  148: # output and optional load validation in
  149: # _validate_module. Centralised here so they are
  150: # easy to find and consistent across the codebase.
  151: # --------------------------------------------------
  152: Readonly my $ENV_TEST_VERBOSE       => 'TEST_VERBOSE';
  153: Readonly my $ENV_GENERATOR_VERBOSE  => 'GENERATOR_VERBOSE';
  154: Readonly my $ENV_VALIDATE_LOAD      => 'GENERATOR_VALIDATE_LOAD';
  155: 
  156: =head1 NAME
  157: 
  158: App::Test::Generator - Fuzz Testing, Mutation Testing, LCSAJ Metrics and Test Dashboard for Perl modules
  159: 
  160: =head1 VERSION
  161: 
  162: Version 0.46
  163: 
  164: =head1 SYNOPSIS
  165: 
  166: C<App::Test::Generator> is a suite to help the testing of CPAN modules.
  167: It consists of 6 subsystems:
  168: 
  169: =over 4
  170: 
  171: =item * Fuzz Tester
  172: 
  173: =item * Mutation Testing
  174: 
  175: =item * LCSAJ Metrics
  176: 
  177: =item * Test Dashboard
  178: 
  179: =item * Benchmark Generation
  180: 
  181: =item * Workflow Deployment
  182: 
  183: =back
  184: 
  185: From the command line:
  186: 
  187:   # Takes the formal definition of a routine, creates tests against that routine, and runs the test
  188:   fuzz-harness-generator -r t/conf/abs.yml
  189: 
  190:   # Attempt to create a formal definition from a routine package, then run tests against that formal definition
  191:   # This is the holy grail of test generation, a set of tests is automatically created directly from the source code,
  192:   extract-schemas lib/App/Test/Generator/Sample/Module.pm && fuzz-harness-generator -r schemas/greet.yml
  193: 
  194:   # Fuzz a module and keep the corpus bounded: trim to the minimum subset that still covers every branch
  195:   extract-schemas --fuzz --minimize-corpus lib/My/Module.pm
  196: 
  197:   # Generate round-trip tests that run every code example in a module's POD and verify the results
  198:   pod-example-tester lib/My/Module.pm --output t/pod_examples.t
  199: 
  200:   # Generate a Benchmark::cmpthese script from a schema; each transform becomes one timed variant
  201:   benchmark-generator -i schemas/abs.yml -o benchmarks/abs.pl
  202: 
  203:   # Copy dashboard.yml and mutate.yml into a module repository's .github/workflows/ directory
  204:   deploy-workflows --target /path/to/my-module
  205: 
  206: From Perl:
  207: 
  208:   use App::Test::Generator qw(generate);
  209:   use App::Test::Generator::SchemaExtractor;
  210: 
  211:   # Generate to STDOUT
  212:   App::Test::Generator->generate("t/conf/abs.yml");
  213: 
  214:   # Generate directly to a file
  215:   App::Test::Generator->generate('t/conf/abs.yml', 't/add_fuzz.t');
  216: 
  217:   # Holy grail mode - read a Perl file, generate tests, and run them
  218:   # This is a long way away yet, but see t/schema_input.t for a proof of concept
  219:   my $extractor = App::Test::Generator::SchemaExtractor->new(
  220:     input_file => 'lib/App/Test/Generator/Template.pm',
  221:     output_dir => '/tmp',
  222:   );
  223:   my $schemas = $extractor->extract_all();
  224:   use File::Temp qw(tempfile);
  225:   foreach my $schema(keys %{$schemas}) {
  226:     my ($fh, $tempfile) = tempfile(SUFFIX => '.t', UNLINK => 1);
  227:     close $fh;
  228:     App::Test::Generator->generate(
  229:       schema => $schemas->{$schema},
  230:       output_file => $tempfile,
  231:     );
  232:     system($^X, '-Ilib', $tempfile);
  233:   }
  234: 
  235: =head1 OVERVIEW
  236: 
  237: This module takes a formal input/output specification for a routine or
  238: method and automatically generates test cases. In effect, it allows you
  239: to easily add comprehensive black-box tests in addition to the more
  240: common white-box tests that are typically written for CPAN modules and other
  241: subroutines.
  242: 
  243: The generated tests combine:
  244: 
  245: =over 4
  246: 
  247: =item * Random fuzzing based on input types
  248: 
  249: =item * Deterministic edge cases for min/max constraints
  250: 
  251: =item * Static corpus tests defined in Perl or YAML
  252: 
  253: =back
  254: 
  255: This approach strengthens your test suite by probing both expected and
  256: unexpected inputs, helping you to catch boundary errors, invalid data
  257: handling, and regressions without manually writing every case.
  258: 
  259: =head1 TOOLS
  260: 
  261: The distribution ships the following command-line tools:
  262: 
  263: =over 4
  264: 
  265: =item * L<benchmark-generator> - generate a self-contained L<Benchmark> C<cmpthese> script from a YAML schema. Each transform in the schema becomes one named variant; representative input values are derived from each parameter's type and range constraints.
  266: 
  267: =item * L<deploy-workflows> - copy C<dashboard.yml> and C<mutate.yml> into the target repository's C<.github/workflows/> directory. Both files are embedded verbatim in the script, so no ATG source tree is needed after installation. Supports C<--target>, C<--force>, and C<--dry-run>.
  268: 
  269: =item * L<extract-schemas> - heuristically extract YAML parameter schemas from a C<.pm> file, with optional coverage-guided fuzzing (C<--fuzz>) and corpus minimization (C<--minimize-corpus>).
  270: 
  271: =item * L<fuzz-harness-generator> - generate a C<Test::Most> fuzzing harness from a YAML schema.
  272: 
  273: =item * L<pod-example-tester> - generate a C<Test::Most> round-trip test file from a module's POD code examples. Annotated examples (C<# returns value> / C<< # => value >>) get C<is()> assertions; unannotated verbatim blocks are wrapped in C<eval{}> and checked for no exception.
  274: 
  275: =item * L<test-generator-mutate> - run mutation testing against a module's test suite.
  276: 
  277: =item * L<test-generator-index> - generate the HTML test-quality dashboard, combining Devel::Cover statement/branch data, LCSAJ path coverage, mutation results, and CPAN Testers failure analysis. For each CPAN Testers FAIL report, also writes a self-contained shell script (C<cover_html/reproduce/reproduce-GUID.sh>) that pins every installed module at its exact failing version, enabling local reproduction of the failure environment.
  278: 
  279: =back
  280: 
  281: =head1 DESCRIPTION
  282: 
  283: This module implements the logic behind L<fuzz-harness-generator>.
  284: It parses configuration files (fuzz and/or corpus YAML), and
  285: produces a ready-to-run F<.t> test script to run through C<prove>.
  286: 
  287: It reads configuration files in any format,
  288: and optional YAML corpus files.
  289: All of the examples in this documentation are in C<YAML> format,
  290: other formats may not work as they aren't so heavily tested.
  291: It then generates a L<Test::Most>-based fuzzing harness combining:
  292: 
  293: =over 4
  294: 
  295: =item * Randomized fuzzing of inputs (with edge cases)
  296: 
  297: =item * Optional static corpus tests from Perl C<%cases> or YAML file (C<yaml_cases> key)
  298: 
  299: =item * Functional or OO mode (via C<$new>)
  300: 
  301: =item * Reproducible runs via C<$seed> and configurable iterations via C<$iterations>
  302: 
  303: =back
  304: 
  305: =head1 MUTATION-GUIDED TEST GENERATION
  306: 
  307: C<App::Test::Generator> includes a pipeline that automatically closes the
  308: feedback loop between mutation testing, schema extraction, and fuzz
  309: testing. The goal is that surviving mutants drive the creation of new
  310: tests that kill them on the next run, without manual intervention.
  311: 
  312: =head2 The Pipeline
  313: 
  314:     mutation survivor
  315:         |
  316:         v
  317:     SchemaExtractor extracts the schema for the enclosing sub
  318:         |
  319:         v
  320:     Schema augmented with boundary values from the mutant
  321:         |
  322:         v
  323:     Augmented schema written to t/conf/
  324:         |
  325:         v
  326:     t/fuzz.t picks up the new schema and runs fuzz tests
  327:         |
  328:         v
  329:     Mutation killed on next run
  330: 
  331: =head2 How to Use It
  332: 
  333: The pipeline is driven by three flags passed to
  334: C<bin/test-generator-index>, which is invoked automatically by
  335: C<bin/generate-test-dashboard> on each CI push.
  336: 
  337: =head3 Step 1: Generate TODO stubs for all survivors
  338: 
  339:     bin/test-generator-index --generate_mutant_tests=t
  340: 
  341: Produces C<t/mutant_YYYYMMDD_HHMMSS.t> containing:
  342: 
  343: =over 4
  344: 
  345: =item * TODO stubs for HIGH and MEDIUM difficulty survivors, with
  346: boundary value suggestions, environment variable hints, and the
  347: enclosing subroutine name for navigation context.
  348: 
  349: =item * Comment-only hints for LOW difficulty survivors.
  350: 
  351: =back
  352: 
  353: Multiple mutations on the same source line are deduplicated into one
  354: stub. One good test kills all variants on that line.
  355: 
  356: =head3 Step 2: Generate runnable schemas for NUM_BOUNDARY survivors
  357: 
  358:     bin/test-generator-index \
  359:         --generate_mutant_tests=t \
  360:         --generate_test=mutant
  361: 
  362: For each NUM_BOUNDARY survivor, calls
  363: L<App::Test::Generator::SchemaExtractor> to extract the schema for
  364: the enclosing subroutine. If the confidence level is sufficient, the
  365: schema is augmented with the boundary value from the mutant (plus one
  366: value either side) and written to C<t/conf/> as a runnable YAML file.
  367: L<t/fuzz.t> picks it up automatically on the next test run.
  368: 
  369: Falls back to a TODO stub if:
  370: 
  371: =over 4
  372: 
  373: =item * SchemaExtractor cannot parse the file
  374: 
  375: =item * The enclosing sub cannot be determined
  376: 
  377: =item * The extracted schema confidence is C<very_low> or C<none>
  378: 
  379: =back
  380: 
  381: =head3 Step 3: Augment existing schemas with survivor boundary values
  382: 
  383:     bin/test-generator-index \
  384:         --generate_mutant_tests=t \
  385:         --generate_test=mutant \
  386:         --generate_fuzz
  387: 
  388: Scans C<t/conf/> for existing YAML schema files (hand-written or
  389: previously generated) and writes augmented copies with boundary values
  390: from surviving NUM_BOUNDARY mutants merged in. The original schema is
  391: never modified. Augmented copies are written as
  392: C<t/conf/mutant_fuzz_YYYYMMDD_HHMMSS_FUNCTION.yml> and picked up
  393: automatically by C<t/fuzz.t>.
  394: 
  395: Schemas whose filename already starts with C<mutant_fuzz_> are skipped
  396: to prevent cascading augmentation. Schemas with no matching survivors
  397: are skipped, with a note if C<--verbose> is active.
  398: 
  399: =head3 Putting It All Together
  400: 
  401: The recommended invocation in C<bin/generate-test-dashboard>
  402: Step 7 runs all three stages together:
  403: 
  404:     bin/test-generator-index \
  405:         --generate_mutant_tests=t \
  406:         --generate_test=mutant \
  407:         --generate_fuzz
  408: 
  409: The GitHub Actions workflow in C<.github/workflows/dashboard.yml>
  410: then commits any new C<t/mutant_*.t> and C<t/conf/mutant_*.yml> files
  411: to the repository so they accumulate over time as the test suite
  412: improves.
  413: 
  414: =head2 Confidence Levels
  415: 
  416: L<App::Test::Generator::SchemaExtractor> assigns a confidence level
  417: to each extracted schema:
  418: 
  419: =over 4
  420: 
  421: =item * C<high> / C<medium> / C<low> - Schema is used for test generation
  422: 
  423: =item * C<very_low> / C<none> - Falls back to TODO stub
  424: 
  425: =back
  426: 
  427: Confidence is based on how much type and constraint information could
  428: be inferred from the source code and its POD documentation. Methods
  429: with explicit parameter validation (L<Params::Validate::Strict>,
  430: L<Params::Get>) or comprehensive POD will produce higher-confidence
  431: schemas.
  432: 
  433: =head2 Files Produced
  434: 
  435: =over 4
  436: 
  437: =item * C<t/mutant_YYYYMMDD_HHMMSS.t>
  438: 
  439: TODO stub file for all survivors. Committed to the repository by the
  440: GitHub Actions workflow.
  441: 
  442: =item * C<t/conf/mutant_MODNAME_FUNCTION_YYYYMMDD_HHMMSS.yml>
  443: 
  444: Runnable YAML schema for a NUM_BOUNDARY survivor where SchemaExtractor
  445: confidence was sufficient. Picked up by C<t/fuzz.t>.
  446: 
  447: =item * C<t/conf/mutant_fuzz_YYYYMMDD_HHMMSS_FUNCTION.yml>
  448: 
  449: Augmented copy of an existing schema with survivor boundary values
  450: merged in. Picked up by C<t/fuzz.t>.
  451: 
  452: =back
  453: 
  454: =head2 See Also
  455: 
  456: =over 4
  457: 
  458: =item * L<App::Test::Generator::SchemaExtractor> - Schema extraction
  459: from Perl source code
  460: 
  461: =item * L<bin/test-generator-index> - Dashboard generator and
  462: pipeline driver
  463: 
  464: =item * L<bin/generate-test-dashboard> - Full pipeline runner
  465: 
  466: =back
  467: 
  468: =encoding utf8
  469: 
  470: =head1 CONFIGURATION
  471: 
  472: The configuration file,
  473: for each set of tests to be produced,
  474: is a file containing a schema that can be read by L<Config::Abstraction>.
  475: 
  476: =head2 SCHEMA
  477: 
  478: The schema is split into several sections.
  479: 
  480: =head3 C<%input> - input params with keys => type/optional specs
  481: 
  482: When using named parameters
  483: 
  484:   input:
  485:     name:
  486:       type: string
  487:       optional: false
  488:     age:
  489:       type: integer
  490:       optional: true
  491: 
  492: Supported basic types used by the fuzzer: C<string>, C<integer>, C<float>, C<number>, C<boolean>, C<arrayref>, C<hashref>.
  493: See also L<Params::Validate::Strict>.
  494: You can add more custom types using properties.
  495: 
  496: For routines with one unnamed parameter
  497: 
  498:   input:
  499:     type: string
  500: 
  501: For routines with more than one named parameter, use the C<position> keyword.
  502: 
  503:   module: Math::Simple::MinMax
  504:   fuction: max
  505: 
  506:   input:
  507:     left:
  508:       type: number
  509:       position: 0
  510:     right:
  511:       type: number
  512:       position: 1
  513: 
  514:   output:
  515:     type: number
  516: 
  517: The keyword C<undef> is used to indicate that the C<function> takes no arguments.
  518: 
  519: =head3 C<%output> - output param types for L<Return::Set> checking
  520: 
  521:   output:
  522:     type: string
  523: 
  524: If the output hash contains the key _STATUS, and if that key is set to DIES,
  525: the routine should die with the given arguments; otherwise, it should live.
  526: If it's set to WARNS,
  527: the routine should warn with the given arguments.
  528: The output can be set to the string 'undef' if the routine should return the undefined value:
  529: 
  530:   ---
  531:   module: Scalar::Util
  532:   function: blessed
  533: 
  534:   input:
  535:     type: string
  536: 
  537:   output: undef
  538: 
  539: The keyword C<undef> is used to indicate that the C<function> returns nothing.
  540: 
  541: For methods that return a list (rather than a reference), use C<type: array>.
  542: The generated test captures the result in list context and validates it as an
  543: arrayref, which requires L<Test::Returns> 0.03 or later:
  544: 
  545:   output:
  546:     type: array
  547: 
  548: =head3 C<%config> - optional hash of configuration.
  549: 
  550: The current supported variables are
  551: 
  552: =over 4
  553: 
  554: =item * C<close_stdin>
  555: 
  556: Tests should not attempt to read from STDIN (default: 1).
  557: This is ignored on Windows, when never closes STDIN.
  558: 
  559: =item * C<test_nuls>, inject NUL bytes into strings (default: 1)
  560: 
  561: With this test enabled, the function is expected to die when a NUL byte is passed in.
  562: 
  563: =item * C<test_undef>, test with undefined value (default: 1)
  564: 
  565: =item * C<test_empty>, test with empty strings (default: 1)
  566: 
  567: =item * C<test_non_ascii>, test with strings that contain non ascii characters (default: 1)
  568: 
  569: =item * C<timeout>, ensure tests don't hang (default: 10)
  570: 
  571: Setting this to 0 disables timeout testing.
  572: 
  573: =item * C<dedup>, fuzzing can create duplicate tests, go some way to remove duplicates (default: 1)
  574: 
  575: =item * C<properties>, enable L<Test::LectroTest> Property tests (default: 0)
  576: 
  577: *item * C<test_security>, send some security string based tests (default: 0)
  578: 
  579: =back
  580: 
  581: All values default to C<true>.
  582: 
  583: =head3 C<%accessor> - this is an accessor routine
  584: 
  585:   accessor:
  586:     property: ua
  587:     type: getset
  588: 
  589: Has two mandatory elements:
  590: 
  591: =over 4
  592: 
  593: =item * C<property>
  594: 
  595: The name of the property in the object that the routine controls.
  596: 
  597: =item * C<type>
  598: 
  599: One of C<getter>, C<setter>, C<getset>.
  600: 
  601: =back
  602: 
  603: =head3 C<%transforms> - list of transformations from input sets to output sets
  604: 
  605: Transforms allow you to define how input data should be transformed into output data.
  606: This is useful for testing functions that convert between formats, normalize data,
  607: or apply business logic transformations on a set of data to different set of data.
  608: It takes a list of subsets of the input and output definitions,
  609: and verifies that data from each input subset is correctly transformed into data from the matching output subset.
  610: 
  611: =head4 Transform Validation Rules
  612: 
  613: For each transform:
  614: 
  615: =over 4
  616: 
  617: =item 1. Generate test cases using the transform's input schema
  618: 
  619: =item 2. Call the function with those inputs
  620: 
  621: =item 3. Validate the output matches the transform's output schema
  622: 
  623: =item 4. If output has a specific 'value', check exact match
  624: 
  625: =item 5. If output has constraints (min/max), validate within bounds
  626: 
  627: =back
  628: 
  629: =head4 Example 1
  630: 
  631:   ---
  632:   module: builtin
  633:   function: abs
  634: 
  635:   config:
  636:     test_undef: no
  637:     test_empty: no
  638:     test_nuls: no
  639:     test_non_ascii: no
  640: 
  641:   input:
  642:     number:
  643:       type: number
  644:       position: 0
  645: 
  646:   output:
  647:     type: number
  648:     min: 0
  649: 
  650:   transforms:
  651:     positive:
  652:       input:
  653:         number:
  654:           type: number
  655:           position: 0
  656:           min: 0
  657:       output:
  658:         type: number
  659:         min: 0
  660:     negative:
  661:       input:
  662:         number:
  663:           type: number
  664:           position: 0
  665:           max: 0
  666:       output:
  667:         type: number
  668:         min: 0
  669:     error:
  670:       input:
  671:         undef
  672:       output:
  673:         _STATUS: DIES
  674: 
  675: If the output hash contains the key _STATUS, and if that key is set to DIES,
  676: the routine should die with the given arguments; otherwise, it should live.
  677: If it's set to WARNS, the routine should warn with the given arguments.
  678: 
  679: The keyword C<undef> is used to indicate that the C<function> returns nothing.
  680: 
  681: =head4 Example 2
  682: 
  683:   ---
  684:   module: Math::Utils
  685:   function: normalize_number
  686: 
  687:   input:
  688:     value:
  689:       type: number
  690:       position: 0
  691: 
  692:   output:
  693:     type: number
  694: 
  695:   transforms:
  696:     positive_stays_positive:
  697:       input:
  698:         value:
  699:           type: number
  700:           min: 0
  701:           max: 1000
  702:       output:
  703:         type: number
  704:         min: 0
  705:         max: 1
  706: 
  707:     negative_becomes_zero:
  708:       input:
  709:         value:
  710:           type: number
  711:           max: 0
  712:       output:
  713:         type: number
  714:         value: 0
  715: 
  716:     preserves_zero:
  717:       input:
  718:         value:
  719:           type: number
  720:           value: 0
  721:       output:
  722:         type: number
  723:         value: 0
  724: 
  725: =head3 C<$module>
  726: 
  727: The name of the module (optional).
  728: 
  729: Using the reserved word C<builtin> means you're testing a Perl builtin function.
  730: 
  731: If omitted, the generator will guess from the config filename:
  732: C<My-Widget.conf> -> C<My::Widget>.
  733: 
  734: =head3 C<$function>
  735: 
  736: The function/method to test.
  737: 
  738: This defaults to C<run>.
  739: 
  740: =head3 C<%new>
  741: 
  742: An optional hashref of args to pass to the module's constructor.
  743: 
  744:   new:
  745:     api_key: ABC123
  746:     verbose: true
  747: 
  748: To ensure C<new()> is called with no arguments, you still need to define new, thus:
  749: 
  750:   module: MyModule
  751:   function: my_function
  752: 
  753:   new:
  754: 
  755: =head3 C<%cases>
  756: 
  757: An optional Perl static corpus, when the output is a simple string (expected => [ args... ]).
  758: 
  759: Maps the expected output string to the input and _STATUS
  760: 
  761:   cases:
  762:     ok:
  763:       input: ping
  764:       _STATUS: OK
  765:     error:
  766:       input: ""
  767:       _STATUS: DIES
  768: 
  769: =head3 C<$yaml_cases> - optional path to a YAML file with the same shape as C<%cases>.
  770: 
  771: =head3 C<$seed>
  772: 
  773: An optional integer.
  774: When provided, the generated C<t/fuzz.t> will call C<srand($seed)> so fuzz runs are reproducible.
  775: 
  776: =head3 C<$iterations>
  777: 
  778: An optional integer controlling how many fuzz iterations to perform (default 30).
  779: 
  780: =head3 C<%edge_cases>
  781: 
  782: An optional hash mapping of extra values to inject.
  783: 
  784: 	# Two named parameters
  785: 	edge_cases:
  786: 		name: [ '', 'a' x 1024, \"\x{263A}" ]
  787: 		age: [ -1, 0, 99999999 ]
  788: 
  789: 	# Takes a string input
  790: 	edge_cases: [ 'foo', 'bar' ]
  791: 
  792: Values can be strings or numbers; strings will be properly quoted.
  793: Note that this only works with routines that take named parameters.
  794: 
  795: =head3 C<%type_edge_cases>
  796: 
  797: An optional hash mapping types to arrayrefs of extra values to try for any field of that type:
  798: 
  799: 	type_edge_cases:
  800: 		string: [ '', ' ', "\t", "\n", "\0", 'long' x 1024, chr(0x1F600) ]
  801: 		number: [ 0, 1.0, -1.0, 1e308, -1e308, 1e-308, -1e-308, 'NaN', 'Infinity' ]
  802: 		integer: [ 0, 1, -1, 2**31-1, -(2**31), 2**63-1, -(2**63) ]
  803: 
  804: =head3 C<%edge_case_array>
  805: 
  806: Specify edge case values for routines that accept a single unnamed parameter.
  807: This is specifically designed for simple functions that take one argument without a parameter name.
  808: These edge cases supplement the normal random string generation, ensuring specific problematic values are always tested.
  809: 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.
  810: 
  811:   ---
  812:   module: Text::Processor
  813:   function: sanitize
  814: 
  815:   input:
  816:     type: string
  817:     min: 1
  818:     max: 1000
  819: 
  820:   edge_case_array:
  821:     - "<script>alert('xss')</script>"
  822:     - "'; DROP TABLE users; --"
  823:     - "\0null\0byte"
  824:     - "emoji😊test"
  825:     - ""
  826:     - " "
  827: 
  828:   seed: 42
  829:   iterations: 30
  830: 
  831: =head3 Semantic Data Generators
  832: 
  833: For property-based testing with L<Test::LectroTest>,
  834: you can use semantic generators to create realistic test data.
  835: 
  836: C<unix_timestamp> is currently fully supported,
  837: other fuzz testing support for C<semantic> entries is being developed.
  838: 
  839:   input:
  840:     email:
  841:       type: string
  842:       semantic: email
  843: 
  844:     user_id:
  845:       type: string
  846:       semantic: uuid
  847: 
  848:     phone:
  849:       type: string
  850:       semantic: phone_us
  851: 
  852: =head4 Available Semantic Types
  853: 
  854: =over 4
  855: 
  856: =item * C<email> - Valid email addresses (user@domain.tld)
  857: 
  858: =item * C<url> - HTTP/HTTPS URLs
  859: 
  860: =item * C<uuid> - UUIDv4 identifiers
  861: 
  862: =item * C<phone_us> - US phone numbers (XXX-XXX-XXXX)
  863: 
  864: =item * C<phone_e164> - International E.164 format (+XXXXXXXXXXXX)
  865: 
  866: =item * C<ipv4> - IPv4 addresses (0.0.0.0 - 255.255.255.255)
  867: 
  868: =item * C<ipv6> - IPv6 addresses
  869: 
  870: =item * C<username> - Alphanumeric usernames with _ and -
  871: 
  872: =item * C<slug> - URL slugs (lowercase-with-hyphens)
  873: 
  874: =item * C<hex_color> - Hex color codes (#RRGGBB)
  875: 
  876: =item * C<iso_date> - ISO 8601 dates (YYYY-MM-DD)
  877: 
  878: =item * C<iso_datetime> - ISO 8601 datetimes (YYYY-MM-DDTHH:MM:SSZ)
  879: 
  880: =item * C<semver> - Semantic version strings (major.minor.patch)
  881: 
  882: =item * C<jwt> - JWT-like tokens (base64url format)
  883: 
  884: =item * C<json> - Simple JSON objects
  885: 
  886: =item * C<base64> - Base64-encoded strings
  887: 
  888: =item * C<md5> - MD5 hashes (32 hex chars)
  889: 
  890: =item * C<sha256> - SHA-256 hashes (64 hex chars)
  891: 
  892: =item * C<unix_timestamp>
  893: 
  894: =back
  895: 
  896: =head2 EDGE CASE GENERATION
  897: 
  898: In addition to purely random fuzz cases, the harness generates
  899: deterministic edge cases for parameters that declare C<min>, C<max> or C<len> in their schema definitions.
  900: 
  901: For each constraint, three edge cases are added:
  902: 
  903: =over 4
  904: 
  905: =item * Just inside the allowable range
  906: 
  907: This case should succeed, since it lies strictly within the bounds.
  908: 
  909: =item * Exactly on the boundary
  910: 
  911: This case should succeed, since it meets the constraint exactly.
  912: 
  913: =item * Just outside the boundary
  914: 
  915: This case is annotated with C<_STATUS = 'DIES'> in the corpus and
  916: should cause the harness to fail validation or croak.
  917: 
  918: =back
  919: 
  920: Supported constraint types:
  921: 
  922: =over 4
  923: 
  924: =item * C<number>, C<integer>, C<float>
  925: 
  926: Uses numeric values one below, equal to, and one above the boundary.
  927: 
  928: =item * C<string>
  929: 
  930: Uses strings of lengths one below, equal to, and one above the boundary.
  931: 
  932: =item * C<arrayref>
  933: 
  934: Uses references to arrays of with the number of elements one below, equal to, and one above the boundary.
  935: 
  936: =item * C<hashref>
  937: 
  938: Uses hashes with key counts one below, equal to, and one above the
  939: boundary (C<min> = minimum number of keys, C<max> = maximum number
  940: of keys).
  941: 
  942: =item * C<memberof> - arrayref of allowed values for a parameter
  943: 
  944: This example is for a routine called C<input()> that takes two arguments: C<status> and C<level>.
  945: C<status> is a string that must have the value C<ok>, C<error> or C<pending>.
  946: The C<level> argument is an integer that must be one of C<1>, C<5> or C<111>.
  947: 
  948:   ---
  949:   input:
  950:     status:
  951:       type: string
  952:       memberof:
  953:         - ok
  954:         - error
  955:         - pending
  956:     level:
  957:       type: integer
  958:       memberof:
  959:         - 1
  960:         - 5
  961:         - 111
  962: 
  963: The generator will automatically create test cases for each allowed value (inside the member list),
  964: and at least one value outside the list (which should die or C<croak>, C<_STATUS = 'DIES'>).
  965: This works for strings, integers, and numbers.
  966: 
  967: =item * C<enum> - synonym of C<memberof>
  968: 
  969: =item * C<boolean> - automatic boundary tests for boolean fields
  970: 
  971:   input:
  972:     flag:
  973:       type: boolean
  974: 
  975: The generator will automatically create test cases for 0 and 1; true and false; off and on, and values that should trigger C<_STATUS = 'DIES'>.
  976: 
  977: =back
  978: 
  979: These edge cases are inserted automatically, in addition to the random
  980: fuzzing inputs, so each run will reliably probe boundary conditions
  981: without relying solely on randomness.
  982: 
  983: =head1 EXAMPLES
  984: 
  985: See the files in C<t/conf> for examples.
  986: 
  987: =head2 Adding Scheduled fuzz Testing with GitHub Actions to Your Code
  988: 
  989: To automatically create and run tests on a regular basis on GitHub Actions,
  990: you need to create a configuration file for each method and subroutine that you're testing,
  991: and a GitHub Actions configuration file.
  992: 
  993: This example takes you through testing the online_render method of L<HTML::Genealogy::Map>.
  994: 
  995: =head3 t/conf/online_render.yml
  996: 
  997:   ---
  998: 
  999:   module: HTML::Genealogy::Map
 1000:   function: onload_render
 1001: 
 1002:   input:
 1003:     gedcom:
 1004:       type: object
 1005:       can: individuals
 1006:     geocoder:
 1007:       type: object
 1008:       can: geocode
 1009:     debug:
 1010:       type: boolean
 1011:       optional: true
 1012:     google_key:
 1013:       type: string
 1014:       optional: true
 1015:       min: 39
 1016:       max: 39
 1017:       matches: "^AIza[0-9A-Za-z_-]{35}$"
 1018: 
 1019:   config:
 1020:     test_undef: 0
 1021: 
 1022: =head3 .github/actions/fuzz.t
 1023: 
 1024:   ---
 1025:   name: Fuzz Testing
 1026: 
 1027:   permissions:
 1028:     contents: read
 1029: 
 1030:   on:
 1031:     push:
 1032:       branches: [main, master]
 1033:     pull_request:
 1034:       branches: [main, master]
 1035:     schedule:
 1036:       - cron: '29 5 14 * *'
 1037: 
 1038:   jobs:
 1039:     generate-fuzz-tests:
 1040:       strategy:
 1041:         fail-fast: false
 1042:         matrix:
 1043:           os:
 1044:             - macos-latest
 1045:             - ubuntu-latest
 1046:             - windows-latest
 1047:           perl: ['5.42', '5.40', '5.38', '5.36', '5.34', '5.32', '5.30', '5.28', '5.22']
 1048: 
 1049:       runs-on: ${{ matrix.os }}
 1050:       name: Fuzz testing with perl ${{ matrix.perl }} on ${{ matrix.os }}
 1051: 
 1052:       steps:
 1053:         - uses: actions/checkout@df4cb1c069e1874edd31b4311f1884172cec0e10 # v6
 1054: 
 1055:         - name: Set up Perl
 1056:           uses: shogo82148/actions-setup-perl@a198315ec4e9244f206879ea7b63078003aec8a6 # v1.41.1
 1057:           with:
 1058:             perl-version: ${{ matrix.perl }}
 1059: 
 1060:         - name: Install App::Test::Generator this module's dependencies
 1061:           run: |
 1062:             cpanm App::Test::Generator
 1063:             cpanm --installdeps .
 1064: 
 1065:         - name: Make Module
 1066:           run: |
 1067:             perl Makefile.PL
 1068:             make
 1069:           env:
 1070:             AUTOMATED_TESTING: 1
 1071:             NONINTERACTIVE_TESTING: 1
 1072: 
 1073:         - name: Generate fuzz tests
 1074:           run: |
 1075:             mkdir t/fuzz
 1076:             find t/conf -name '*.yml' | while read config; do
 1077:               test_name=$(basename "$config" .conf)
 1078:               fuzz-harness-generator "$config" > "t/fuzz/${test_name}_fuzz.t"
 1079:             done
 1080: 
 1081:         - name: Run generated fuzz tests
 1082:           run: |
 1083:             prove -lr t/fuzz/
 1084:           env:
 1085:             AUTOMATED_TESTING: 1
 1086:             NONINTERACTIVE_TESTING: 1
 1087: 
 1088: =head2 Fuzz Testing your CPAN Module
 1089: 
 1090: Running fuzz tests when you run C<make test> in your CPAN module.
 1091: 
 1092: Create a directory <t/conf> which contains the schemas.
 1093: 
 1094: Then create this file as <t/fuzz.t>:
 1095: 
 1096:   #!/usr/bin/env perl
 1097: 
 1098:   use strict;
 1099:   use warnings;
 1100: 
 1101:   use FindBin qw($Bin);
 1102:   use IPC::Run3;
 1103:   use IPC::System::Simple qw(system);
 1104:   use Test::Needs 'App::Test::Generator';
 1105:   use Test::Most;
 1106: 
 1107:   my $dirname = "$Bin/conf";
 1108: 
 1109:   if((-d $dirname) && opendir(my $dh, $dirname)) {
 1110: 	while (my $filename = readdir($dh)) {
 1111: 		# Skip '.' and '..' entries and vi temporary files
 1112: 		next if ($filename eq '.' || $filename eq '..') || ($filename =~ /\.swp$/);
 1113: 
 1114: 		my $filepath = "$dirname/$filename";
 1115: 
 1116: 		if(-f $filepath) {	# Check if it's a regular file
 1117: 			my ($stdout, $stderr);
 1118: 			run3 ['fuzz-harness-generator', '-r', $filepath], undef, \$stdout, \$stderr;
 1119: 
 1120: 			ok($? == 0, 'Generated test script exits successfully');
 1121: 
 1122: 			if($? == 0) {
 1123: 				ok($stdout =~ /^Result: PASS/ms);
 1124: 				if($stdout =~ /Files=1, Tests=(\d+)/ms) {
 1125: 					diag("$1 tests run");
 1126: 				}
 1127: 			} else {
 1128: 				diag("$filepath: STDOUT:\n$stdout");
 1129: 				diag($stderr) if(length($stderr));
 1130: 				diag("$filepath Failed");
 1131: 				last;
 1132: 			}
 1133: 			diag($stderr) if(length($stderr));
 1134: 		}
 1135: 	}
 1136: 	closedir($dh);
 1137:   }
 1138: 
 1139:   done_testing();
 1140: 
 1141: =head2 Property-Based Testing with Transforms
 1142: 
 1143: The generator can create property-based tests using L<Test::LectroTest> when the
 1144: C<properties> configuration option is enabled.
 1145: This provides more comprehensive
 1146: testing by automatically generating thousands of test cases and verifying that
 1147: mathematical properties hold across all inputs.
 1148: 
 1149: =head3 Basic Property-Based Transform Example
 1150: 
 1151: Here's a complete example testing the C<abs> builtin function:
 1152: 
 1153: B<t/conf/abs.yml>:
 1154: 
 1155:   ---
 1156:   module: builtin
 1157:   function: abs
 1158: 
 1159:   config:
 1160:     test_undef: no
 1161:     test_empty: no
 1162:     test_nuls: no
 1163:     properties:
 1164:       enable: true
 1165:       trials: 1000
 1166: 
 1167:   input:
 1168:     number:
 1169:       type: number
 1170:       position: 0
 1171: 
 1172:   output:
 1173:     type: number
 1174:     min: 0
 1175: 
 1176:   transforms:
 1177:     positive:
 1178:       input:
 1179:         number:
 1180:           type: number
 1181:           min: 0
 1182:       output:
 1183:         type: number
 1184:         min: 0
 1185: 
 1186:     negative:
 1187:       input:
 1188:         number:
 1189:           type: number
 1190:           max: 0
 1191:       output:
 1192:         type: number
 1193:         min: 0
 1194: 
 1195: This configuration:
 1196: 
 1197: =over 4
 1198: 
 1199: =item * Enables property-based testing with 1000 trials per property
 1200: 
 1201: =item * Defines two transforms: one for positive numbers, one for negative
 1202: 
 1203: =item * Automatically generates properties that verify C<abs()> always returns non-negative numbers
 1204: 
 1205: =back
 1206: 
 1207: Generate the test:
 1208: 
 1209:   fuzz-harness-generator t/conf/abs.yml > t/abs_property.t
 1210: 
 1211: The generated test will include:
 1212: 
 1213: =over 4
 1214: 
 1215: =item * Traditional edge-case tests for boundary conditions
 1216: 
 1217: =item * Random fuzzing with 30 iterations (or as configured)
 1218: 
 1219: =item * Property-based tests that verify the transforms with 1000 trials each
 1220: 
 1221: =back
 1222: 
 1223: =head3 What Properties Are Tested?
 1224: 
 1225: The generator automatically detects and tests these properties based on your transform specifications:
 1226: 
 1227: =over 4
 1228: 
 1229: =item * B<Range constraints> - If output has C<min> or C<max>, verifies results stay within bounds
 1230: 
 1231: =item * B<Type preservation> - Ensures numeric inputs produce numeric outputs
 1232: 
 1233: =item * B<Definedness> - Verifies the function doesn't return C<undef> unexpectedly
 1234: 
 1235: =item * B<Specific values> - If output specifies a C<value>, checks exact equality
 1236: 
 1237: =back
 1238: 
 1239: For the C<abs> example above, the generated properties verify:
 1240: 
 1241:   # For the "positive" transform:
 1242:   - Given a positive number, abs() returns >= 0
 1243:   - The result is a valid number
 1244:   - The result is defined
 1245: 
 1246:   # For the "negative" transform:
 1247:   - Given a negative number, abs() returns >= 0
 1248:   - The result is a valid number
 1249:   - The result is defined
 1250: 
 1251: =head3 Advanced Example: String Normalization
 1252: 
 1253: Here's a more complex example testing a string normalization function:
 1254: 
 1255: B<t/conf/normalize.yml>:
 1256: 
 1257:   ---
 1258:   module: Text::Processor
 1259:   function: normalize_whitespace
 1260: 
 1261:   config:
 1262:     properties:
 1263:       enable: true
 1264:       trials: 500
 1265: 
 1266:   input:
 1267:     text:
 1268:       type: string
 1269:       min: 0
 1270:       max: 1000
 1271:       position: 0
 1272: 
 1273:   output:
 1274:     type: string
 1275:     min: 0
 1276:     max: 1000
 1277: 
 1278:   transforms:
 1279:     empty_preserved:
 1280:       input:
 1281:         text:
 1282:           type: string
 1283:           value: ""
 1284:       output:
 1285:         type: string
 1286:         value: ""
 1287: 
 1288:     single_space:
 1289:       input:
 1290:         text:
 1291:           type: string
 1292:           min: 1
 1293:           matches: '^\S+(\s+\S+)*$'
 1294:       output:
 1295:         type: string
 1296:         matches: '^\S+( \S+)*$'
 1297: 
 1298:     length_bounded:
 1299:       input:
 1300:         text:
 1301:           type: string
 1302:           min: 1
 1303:           max: 100
 1304:       output:
 1305:         type: string
 1306:         min: 1
 1307:         max: 100
 1308: 
 1309: This tests that the normalization function:
 1310: 
 1311: =over 4
 1312: 
 1313: =item * Preserves empty strings (C<empty_preserved> transform)
 1314: 
 1315: =item * Collapses multiple spaces into single spaces (C<single_space> transform)
 1316: 
 1317: =item * Maintains length constraints (C<length_bounded> transform)
 1318: 
 1319: =back
 1320: 
 1321: =head3 Interpreting Property Test Results
 1322: 
 1323: When property-based tests run, you'll see output like:
 1324: 
 1325:   ok 123 - negative property holds (1000 trials)
 1326:   ok 124 - positive property holds (1000 trials)
 1327: 
 1328: If a property fails, Test::LectroTest will attempt to find the minimal failing
 1329: case and display it:
 1330: 
 1331:   not ok 123 - positive property holds (47 trials)
 1332:   # Property failed
 1333:   # Reason: counterexample found
 1334: 
 1335: This helps you quickly identify edge cases that your function doesn't handle correctly.
 1336: 
 1337: =head3 Configuration Options for Property-Based Testing
 1338: 
 1339: In the C<config> section:
 1340: 
 1341:   config:
 1342:     properties:
 1343:       enable: true     # Enable property-based testing (default: false)
 1344:       trials: 1000     # Number of test cases per property (default: 1000)
 1345: 
 1346: You can also disable traditional fuzzing and only use property-based tests:
 1347: 
 1348:   config:
 1349:     properties:
 1350:       enable: true
 1351:       trials: 5000
 1352: 
 1353:   iterations: 0  # Disable random fuzzing, use only property tests
 1354: 
 1355: =head3 When to Use Property-Based Testing
 1356: 
 1357: Property-based testing with transforms is particularly useful for:
 1358: 
 1359: =over 4
 1360: 
 1361: =item * Mathematical functions (C<abs>, C<sqrt>, C<min>, C<max>, etc.)
 1362: 
 1363: =item * Data transformations (encoding, normalization, sanitization)
 1364: 
 1365: =item * Parsers and formatters
 1366: 
 1367: =item * Functions with clear input-output relationships
 1368: 
 1369: =item * Code that should satisfy mathematical properties (commutativity, associativity, idempotence)
 1370: 
 1371: =back
 1372: 
 1373: =head3 Requirements
 1374: 
 1375: Property-based testing requires both L<Test::LectroTest> and
 1376: L<Test::LectroTest::Compat> to be installed:
 1377: 
 1378:   cpanm Test::LectroTest Test::LectroTest::Compat
 1379: 
 1380: L<Test::LectroTest::Compat> provides the C<use_ok> bridge between
 1381: L<Test::LectroTest> and L<Test::Most>; it is used in every generated
 1382: property-based test file.  Both are declared in the distribution's
 1383: C<TEST_REQUIRES> so they are installed automatically during C<make test>.
 1384: 
 1385: If not installed, the generated tests will automatically skip the property-based
 1386: portion with a message.
 1387: 
 1388: =head3 Testing Email Validation
 1389: 
 1390:   ---
 1391:   module: Email::Valid
 1392:   function: rfc822
 1393: 
 1394:   config:
 1395:     properties:
 1396:       enable: true
 1397:       trials: 200
 1398:     close_stdin: true
 1399:     test_undef: no
 1400:     test_empty: no
 1401:     test_nuls: no
 1402: 
 1403:   input:
 1404:     email:
 1405:       type: string
 1406:       semantic: email
 1407:       position: 0
 1408: 
 1409:   output:
 1410:     type: boolean
 1411: 
 1412:   transforms:
 1413:     valid_emails:
 1414:       input:
 1415:         email:
 1416:           type: string
 1417:           semantic: email
 1418:       output:
 1419:         type: boolean
 1420: 
 1421: This generates 200 realistic email addresses for testing, rather than random strings.
 1422: 
 1423: =head3 Combining Semantic with Regex
 1424: 
 1425: You can combine semantic generators with regex validation:
 1426: 
 1427:   input:
 1428:     corporate_email:
 1429:       type: string
 1430:       semantic: email
 1431:       matches: '@company\.com$'
 1432: 
 1433: The semantic generator creates realistic emails, and the regex ensures they match your domain.
 1434: 
 1435: =head3 Custom Properties for Transforms
 1436: 
 1437: You can define additional properties that should hold for your transforms beyond
 1438: the automatically detected ones.
 1439: 
 1440: =head4 Using Built-in Properties
 1441: 
 1442:   transforms:
 1443:     positive:
 1444:       input:
 1445:         number:
 1446:           type: number
 1447:           min: 0
 1448:       output:
 1449:         type: number
 1450:         min: 0
 1451:       properties:
 1452:         - idempotent       # f(f(x)) == f(x)
 1453:         - non_negative     # result >= 0
 1454:         - positive         # result > 0
 1455: 
 1456: Available built-in properties:
 1457: 
 1458: =over 4
 1459: 
 1460: =item * C<idempotent> - Function is idempotent: f(f(x)) == f(x)
 1461: 
 1462: =item * C<non_negative> - Result is always >= 0
 1463: 
 1464: =item * C<positive> - Result is always > 0
 1465: 
 1466: =item * C<non_empty> - String result is never empty
 1467: 
 1468: =item * C<length_preserved> - Output length equals input length
 1469: 
 1470: =item * C<uppercase> - Result is all uppercase
 1471: 
 1472: =item * C<lowercase> - Result is all lowercase
 1473: 
 1474: =item * C<trimmed> - No leading/trailing whitespace
 1475: 
 1476: =item * C<sorted_ascending> - Array is sorted ascending
 1477: 
 1478: =item * C<sorted_descending> - Array is sorted descending
 1479: 
 1480: =item * C<unique_elements> - Array has no duplicates
 1481: 
 1482: =item * C<preserves_keys> - Hash has same keys as input
 1483: 
 1484: =back
 1485: 
 1486: =head4 Custom Property Code
 1487: 
 1488: Custom properties allows the definition additional invariants and relationships that should hold for their transforms,
 1489: beyond what's auto-detected.
 1490: For example:
 1491: 
 1492: =over 4
 1493: 
 1494: =item * Idempotence: f(f(x)) == f(x)
 1495: 
 1496: =item * Commutativity: f(x, y) == f(y, x)
 1497: 
 1498: =item * Associativity: f(f(x, y), z) == f(x, f(y, z))
 1499: 
 1500: =item * Inverse relationships: decode(encode(x)) == x
 1501: 
 1502: =item * Domain-specific invariants: Custom business logic
 1503: 
 1504: =back
 1505: 
 1506: Define your own properties with custom Perl code:
 1507: 
 1508:   transforms:
 1509:     normalize:
 1510:       input:
 1511:         text:
 1512:           type: string
 1513:       output:
 1514:         type: string
 1515:       properties:
 1516:         - name: single_spaces
 1517:           description: "No multiple consecutive spaces"
 1518:           code: $result !~ /  /
 1519: 
 1520:         - name: no_leading_space
 1521:           description: "No space at start"
 1522:           code: $result !~ /^\s/
 1523: 
 1524:         - name: reversible
 1525:           description: "Can be reversed back"
 1526:           code: length($result) == length($text)
 1527: 
 1528: The code has access to:
 1529: 
 1530: =over 4
 1531: 
 1532: =item * C<$result> - The function's return value
 1533: 
 1534: =item * Input variables - All input parameters (e.g., C<$text>, C<$number>)
 1535: 
 1536: =item * The function itself - Can call it again for idempotence checks
 1537: 
 1538: =back
 1539: 
 1540: =head4 Combining Auto-detected and Custom Properties
 1541: 
 1542: The generator automatically detects properties from your output spec, and adds
 1543: your custom properties:
 1544: 
 1545:   transforms:
 1546:     sanitize:
 1547:       input:
 1548:         html:
 1549:           type: string
 1550:       output:
 1551:         type: string
 1552:         min: 0              # Auto-detects: defined, min_length >= 0
 1553:         max: 10000
 1554:       properties:           # Additional custom checks:
 1555:         - name: no_scripts
 1556:           code: $result !~ /<script/i
 1557:         - name: no_iframes
 1558:           code: $result !~ /<iframe/i
 1559: 
 1560: =head2 GENERATED OUTPUT
 1561: 
 1562: The generated test:
 1563: 
 1564: =over 4
 1565: 
 1566: =item * Seeds RND (if configured) for reproducible fuzz runs
 1567: 
 1568: =item * Uses edge cases (per-field and per-type) with configurable probability
 1569: 
 1570: =item * Runs C<$iterations> fuzz cases plus appended edge-case runs
 1571: 
 1572: =item * Validates inputs with Params::Get / Params::Validate::Strict
 1573: 
 1574: =item * Validates outputs with L<Return::Set>
 1575: 
 1576: =item * Runs static C<is(... )> corpus tests from Perl and/or YAML corpus
 1577: 
 1578: =item * Runs L<Test::LectroTest> tests
 1579: 
 1580: =back
 1581: 
 1582: =cut
 1583: 
 1584: =head1 METHODS
 1585: 
 1586: =head2 generate
 1587: 
 1588: Takes a schema file and produces a test file (or STDOUT).
 1589: 
 1590:   # Modern named API
 1591:   App::Test::Generator->generate(
 1592:       schema_file => 'schemas/foo.yml',
 1593:       output_file => 'test/foo.t',
 1594:   );
 1595: 
 1596:   # Legacy positional API
 1597:   App::Test::Generator->generate($schema_file, $test_file);
 1598: 
 1599: =head3 API Specification
 1600: 
 1601: =head4 Input
 1602: 
 1603:     {
 1604:         schema_file => { type => 'string', optional => 0 },
 1605:         input_file  => { type => 'string', optional => 1 },
 1606:         output_file => { type => 'string', optional => 1, max => 255 },
 1607:     }
 1608: 
 1609: =head4 Output
 1610: 
 1611:     { type => 'string' }
 1612: 
 1613: =cut
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1614: 
 1615: sub generate
 1616: {
●1617 → 1629 → 1665 1617: 	croak 'Usage: generate(schema_file [, outfile])' if(scalar(@_) == 0);
 1618: 
 1619: 	# Accept both class-method call (App::Test::Generator->generate(...))
 1620: 	# and plain-function call with a hashref (generate({...})).
 1621: 	# In the method form the first arg is the class name (a plain string);
 1622: 	# in the function form with a hashref the first arg IS the hashref.
 1623: 	my $class = (ref($_[0]) ne 'HASH') ? shift : undef;
 1624: 	my ($schema_file, $test_file, $schema);
 1625: 	# Globals loaded from the user's conf (all optional except function maybe)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1626: 	my ($module, $function, $new, $yaml_cases);
 1627: 	my ($seed, $iterations);
 1628: 
 1629: 	if((ref($_[0]) eq 'HASH') || defined($_[2])) {
 1630: 		# Modern API
 1631: 		my $params = Params::Validate::Strict::validate_strict({
 1632: 			args => Params::Get::get_params(undef, \@_),
 1633: 			schema => {
 1634: 				input_file => { type => 'string', optional => 1 },
 1635: 				schema_file => { type => 'string', optional => 1 },
 1636: 				output_file => { type => 'string', optional => 1 },
 1637: 				schema => { type => 'hashref', optional => 1 },
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1638: 				quiet => { type => 'boolean', optional => 1 },	# Not yet used
 1639: 			}
 1640: 		});
 1641: 		if($params->{'schema_file'}) {
 1642: 			$schema_file = $params->{'schema_file'};
 1643: 		} elsif($params->{'input_file'}) {
 1644: 			$schema_file = $params->{'input_file'};
 1645: 		} elsif($params->{'schema'}) {
 1646: 			$schema = $params->{'schema'};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1647: 		} else {
 1648: 			croak(__PACKAGE__, ': Usage: generate(input_file|schema [, output_file]');
 1649: 		}
 1650: 		if(defined($schema_file)) {
 1651: 			$schema = _load_schema($schema_file);
 1652: 		}
 1653: 		$test_file = $params->{'output_file'};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1654: 	} else {
 1655: 		# Legacy API
 1656: 		($schema_file, $test_file) = @_;
 1657: 		if(defined($schema_file)) {
 1658: 			$schema = _load_schema($schema_file);
 1659: 		} else {
 1660: 			croak 'Usage: generate(schema_file [, outfile])';
 1661: 		}
 1662: 	}
 1663: 
 1664: 	# Parse the schema file and load into our structures
●1665 → 1676 → 1679 1665: 	my %input = %{_load_schema_section($schema, 'input', $schema_file)};
 1666: 	my %output = %{_load_schema_section($schema, 'output', $schema_file)};
 1667: 	my %transforms = %{_load_schema_section($schema, 'transforms', $schema_file)};
 1668: 	my %accessor = %{_load_schema_section($schema, 'accessor', $schema_file)};
 1669: 
 1670: 	my %cases = %{$schema->{cases}} if(exists($schema->{cases}));
 1671: 	my %edge_cases = %{$schema->{edge_cases}} if(exists($schema->{edge_cases}));
 1672: 	my %type_edge_cases = %{$schema->{type_edge_cases}} if(exists($schema->{type_edge_cases}));
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1673: 
 1674: 	$module = $schema->{module} if(exists($schema->{module}) && length($schema->{module}));
 1675: 	$function = $schema->{function} if(exists($schema->{function}));
 1676: 	if(exists($schema->{new})) {
 1677: 		$new = defined($schema->{'new'}) ? $schema->{new} : '_UNDEF';
 1678: 	}
●1679 → 1691 → 1705 1679: 	$yaml_cases = $schema->{yaml_cases} if(exists($schema->{yaml_cases}));
 1680: 	$seed = $schema->{seed} if(exists($schema->{seed}));
 1681: 	$iterations = $schema->{iterations} if(exists($schema->{iterations}));
 1682: 
 1683: 	my @edge_case_array = @{$schema->{edge_case_array}} if(exists($schema->{edge_case_array}));
 1684: 	_validate_config($schema);
 1685: 
 1686: 	my %config = %{$schema->{config}} if(exists($schema->{config}));
 1687: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1688: 	_normalize_config(\%config);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1689: 
 1690: 	# Guess module name from config file if not set
 1691: 	if(!$module) {
 1692: 		if($schema_file) {
 1693: 			($module = basename($schema_file)) =~ s/\.(conf|pl|pm|yml|yaml)$//;

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1693_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1694: 			$module =~ s/-/::/g;
 1695: 			# Guard against Perl builtin function names being mistaken
 1696: 			# for module names — builtins have no module to load
 1697: 			if(_is_perl_builtin($module)) {
 1698: 				undef $module;
 1699: 			}
 1700: 		}
 1701: 	} elsif($module eq $MODULE_BUILTIN) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1702: 		undef $module;
 1703: 	}
 1704: 
●1705 → 1705 → 1712 1705: 	if($module && length($module) && ($module ne 'builtin')) {
 1706: 		_validate_module($module, $schema_file);
 1707: 	}
 1708: 
 1709: 	# $module/$function are spliced unescaped into generated test
 1710: 	# source below (use_ok, new_ok, ->$function, $module::$function)
 1711: 	# — reject anything that isn't identifier-shaped before that happens.
●1712 → 1725 → 1746 1712: 	_assert_identifier($module, 'module', package => 1) if defined($module) && length($module);
 1713: 
 1714: 	# sensible defaults
 1715: 	$function ||= 'run';
 1716: 	# package => 1: fully-qualified sub names (e.g. DB::DB, a debugger
 1717: 	# hook installed into the DB:: package regardless of its source
 1718: 	# package) are legitimate function names, not just bare identifiers
 1719: 	_assert_identifier($function, 'function', package => 1);
 1720: 	$iterations ||= $DEFAULT_ITERATIONS;		 # default fuzz runs if not specified
 1721: 	$seed = undef if defined $seed && $seed eq '';	# treat empty as undef
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1722: 
 1723: 	# --- YAML corpus support (yaml_cases is filename string) ---
 1724: 	my %yaml_corpus_data;
 1725: 	if (defined $yaml_cases) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1726: 		croak("$yaml_cases: $!") if(!-f $yaml_cases);
 1727: 
 1728: 		my $yaml_data = LoadFile(Encode::decode('utf8', $yaml_cases));
 1729: 		if ($yaml_data && ref($yaml_data) eq 'HASH') {
 1730: 			# Validate that the corpus inputs are arrayrefs
 1731: 			# e.g: "FooBar": 	["foo_bar"]
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1732: 			# Skip only invalid entries:
 1733: 			for my $expected (keys %{$yaml_data}) {
 1734: 				my $outputs = $yaml_data->{$expected};
 1735: 				unless($outputs && (ref $outputs eq 'ARRAY')) {
 1736: 					carp("$yaml_cases: $expected does not point to an array ref, ignoring");
 1737: 					next;
 1738: 				}
 1739: 				$yaml_corpus_data{$expected} = $outputs;
 1740: 			}
 1741: 		}
 1742: 	}
 1743: 
 1744: 	# Merge Perl %cases and YAML corpus safely
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1745: 	# my %all_cases = (%cases, %yaml_corpus_data);
●1746 → 1747 → 1753 1746: 	my %all_cases = (%yaml_corpus_data, %cases);
 1747: 	for my $k (keys %yaml_corpus_data) {
 1748: 		if (exists $cases{$k} && ref($cases{$k}) eq 'ARRAY' && ref($yaml_corpus_data{$k}) eq 'ARRAY') {
 1749: 			$all_cases{$k} = [ @{$yaml_corpus_data{$k}}, @{$cases{$k}} ];

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1749_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1750: 		}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1750_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1751: 	}
 1752: 
●1753 → 1753 → 1763 1753: 	if(my $hints = delete $schema->{_yamltest_hints}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1753_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1754: 		if(my $boundaries = $hints->{boundary_values}) {
 1755: 			push @edge_case_array, @{$boundaries};
 1756: 		}
 1757: 		if(my $invalid = $hints->{invalid}) {
 1758: 			carp('TODO: handle yamltest_hints->invalid');
 1759: 		}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1759_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1760: 	}
 1761: 
 1762: 	# If the schema says the type is numeric, normalize
●1763 → 1763 → 1773 1763: 	if ($schema->{type} && $schema->{type} =~ /^(integer|number|float)$/) {
 1764: 		for (@edge_case_array) {
 1765: 			next unless defined $_;
 1766: 			$_ += 0 if Scalar::Util::looks_like_number($_);
 1767: 		}
 1768: 	}
 1769: 
 1770: 	# Load relationships from the schema if present and well-formed.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1771: 	# SchemaExtractor may set this to undef or an empty arrayref when
 1772: 	# no relationships were detected, so guard both existence and type.
●1773 → 1774 → 1782 1773: 	my @relationships;
 1774: 	if(exists($schema->{relationships}) && ref($schema->{relationships}) eq 'ARRAY') {
 1775: 		@relationships = @{$schema->{relationships}};
 1776: 	}
 1777: 
 1778: 	# Serialise the relationships array from the schema into Perl source
 1779: 	# code for embedding in the generated test file. Each relationship
 1780: 	# type is rendered as a hashref in the @relationships array.
 1781: 
●1782 → 1785 → 1834 1782: 	my $relationships_code = '';
 1783: 
 1784: 	# Walk each relationship in the order SchemaExtractor produced them
 1785: 	for my $rel (@relationships) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1785_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1786: 		my $type = $rel->{type} // '';
 1787: 
 1788: 		# Mutually exclusive: both params being set should cause the method to die
 1789: 		if($type eq 'mutually_exclusive') {
 1790: 			$relationships_code .= "{ type => 'mutually_exclusive', params => [" .
 1791: 				join(', ', map { perl_quote($_) } @{$rel->{params}}) .
 1792: 				"] },\n";
 1793: 
 1794: 		# Required group: at least one of the params must be present
 1795: 		} elsif($type eq 'required_group') {
 1796: 			$relationships_code .= "{ type => 'required_group', params => [" .
 1797: 				join(', ', map { perl_quote($_) } @{$rel->{params}}) .
 1798: 				"], logic => " . perl_quote($rel->{logic} // 'or') . " },\n";
 1799: 
 1800: 		# Conditional requirement: if one param is set, another becomes mandatory
 1801: 		} elsif($type eq 'conditional_requirement') {
 1802: 			$relationships_code .= "{ type => 'conditional_requirement', if => " .
 1803: 				perl_quote($rel->{'if'}) . ", then_required => " .
 1804: 				perl_quote($rel->{then_required}) . " },\n";
 1805: 
 1806: 		# Dependency: one param requires another to also be present
 1807: 		} elsif($type eq 'dependency') {
 1808: 			$relationships_code .= "{ type => 'dependency', param => " .
 1809: 				perl_quote($rel->{param}) . ", requires => " .
 1810: 				perl_quote($rel->{requires}) . " },\n";
 1811: 
 1812: 		# Value constraint: one param being set forces another to a specific value
 1813: 		} elsif($type eq 'value_constraint') {
 1814: 			$relationships_code .= "{ type => 'value_constraint', if => " .
 1815: 				perl_quote($rel->{'if'}) . ", then => " .
 1816: 				perl_quote($rel->{then}) . ", operator => " .
 1817: 				perl_quote($rel->{operator}) . ", value => " .
 1818: 				perl_quote($rel->{value}) . " },\n";
 1819: 
 1820: 		# Value conditional: one param equalling a specific value requires another param
 1821: 		} elsif($type eq 'value_conditional') {
 1822: 			$relationships_code .= "{ type => 'value_conditional', if => " .
 1823: 				perl_quote($rel->{'if'}) . ", equals => " .
 1824: 				perl_quote($rel->{equals}) . ", then_required => " .
 1825: 				perl_quote($rel->{then_required}) . " },\n";
 1826: 
 1827: 		# Unknown type — warn and skip rather than emitting broken code
 1828: 		} else {
 1829: 			carp "Unknown relationship type '$type', skipping";
 1830: 		}
 1831: 	}
 1832: 
 1833: 	# Dedup the edge cases
●1834 → 1859 → 1864 1834: 	my %seen;
 1835: 	@edge_case_array = grep {
 1836: 		my $key = defined($_) ? (Scalar::Util::looks_like_number($_) ? "N:$_" : "S:$_") : 'U';
 1837: 		!$seen{$key}++;
 1838: 	} @edge_case_array;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1838_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1838_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1839: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1839_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1839_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1840: 	# Sort the edge cases to keep it consistent across runs
 1841: 	@edge_case_array = sort {
 1842: 		return -1 if !defined $a;
 1843: 		return 1 if !defined $b;
 1844: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1844_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1844_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1845: 		my $na = Scalar::Util::looks_like_number($a);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1845_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1845_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1846: 		my $nb = Scalar::Util::looks_like_number($b);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1846_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1846_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1847: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1847_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1847_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1848: 		return $a <=> $b if $na && $nb;
 1849: 		return -1 if $na;
 1850: 		return 1 if $nb;
 1851: 		return $a cmp $b;
 1852: 	} @edge_case_array;
 1853: 
 1854: 	# render edge case maps for inclusion in the .t
 1855: 	my $edge_cases_code = render_arrayref_map(\%edge_cases);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1856: 	my $type_edge_cases_code = render_arrayref_map(\%type_edge_cases);
 1857: 
 1858: 	my $edge_case_array_code = '';
 1859: 	if(scalar(@edge_case_array)) {
 1860: 		$edge_case_array_code = join(', ', map { q_wrap($_) } @edge_case_array);
 1861: 	}
 1862: 
 1863: 	# Render configuration - all the values are integers for now, if that changes, wrap the $config{$key} in single quotes
●1864 → 1865 → 1881 1864: 	my $config_code = '';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1865: 	foreach my $key (sort keys %config) {
 1866: 		# Skip nested structures like 'properties' - they're used during
 1867: 		# generation but don't need to be in the generated test
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1868: 		if(ref($config{$key}) eq 'HASH') {
 1869: 			next;
 1870: 		}
 1871: 		if((!defined($config{$key})) || !$config{$key}) {
 1872: 			# YAML will strip the word 'false'
 1873: 			# e.g. in 'test_undef: false'
 1874: 			$config_code .= "'$key' => 0,\n";
 1875: 		} else {
 1876: 			$config_code .= "'$key' => $config{$key},\n";
 1877: 		}
 1878: 	}

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
NUM_BOUNDARY_1878_27_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
COND_INV_1878_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1879: 
 1880: 	# Render input/output
●1881 → 1882 → 1891 1881: 	my $input_code = '';
 1882: 	if(((scalar keys %input) == 1) && exists($input{'type'}) && !ref($input{'type'})) {
 1883: 		# %input = ( type => 'string' );
 1884: 		foreach my $key (sort keys %input) {
 1885: 			$input_code .= "'$key' => '$input{$key}',\n";
 1886: 		}
 1887: 	} else {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1888: 		# %input = ( str => { type => 'string' } );

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1888_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1889: 		$input_code = render_hash(\%input);
 1890: 	}
●1891 → 1891 → 1908 1891: 	if(defined(my $re = $output{'matches'})) {
 1892: 		if(ref($re) ne 'Regexp') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1892_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1893: 			# Use eval to compile safely — qr/$re/ would interpolate
 1894: 			# the string first, corrupting patterns containing [ or \
 1895: 			my $compiled = eval { qr/$re/ };
 1896: 			if($@) {
 1897: 				carp("Invalid matches pattern '$re': $@");
 1898: 			} else {
 1899: 				$output{'matches'} = $compiled;
 1900: 			}
 1901: 		}
 1902: 	}
 1903: 
 1904: 	# Compile nomatch pattern to a Regexp object so it renders
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1905: 	# as qr{} in the generated test rather than a raw string.

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1905_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1906: 	# Without this, patterns containing [ or other regex
 1907: 	# metacharacters cause compilation failures in validators
●1908 → 1908 → 1921 1908: 	if(defined(my $re = $output{'nomatch'})) {
 1909: 		if(ref($re) ne 'Regexp') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1909_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1910: 			# Use eval to compile safely — qr/$re/ would interpolate
 1911: 			# the string first, corrupting patterns containing [ or \
 1912: 			my $compiled = eval { qr/$re/ };
 1913: 			if($@) {
 1914: 				carp("Invalid nomatch pattern '$re': $@");
 1915: 			} else {
 1916: 				$output{'nomatch'} = $compiled;
 1917: 			}
 1918: 		}
 1919: 	}
 1920: 
●1921 → 1925 → 1943 1921: 	my $output_code = render_args_hash(\%output);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1922: 	my $new_code = ($new && (ref $new eq 'HASH')) ? render_args_hash($new) : '';
 1923: 
 1924: 	my $transforms_code;
 1925: 	if(keys %transforms) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1925_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1926: 		foreach my $transform(keys %transforms) {
 1927: 			my $properties = render_fallback($transforms{$transform}->{'properties'});
 1928: 
 1929: 			if($transforms_code) {
 1930: 				$transforms_code .= "},\n";
 1931: 			}
 1932: 			$transforms_code .= "$transform => {\n" .
 1933: 				"\t'input' => { " .
 1934: 				render_args_hash($transforms{$transform}->{'input'}) .
 1935: 				"\t}, 'output' => { " .
 1936: 				render_args_hash($transforms{$transform}->{'output'}) .
 1937: 				"\t}, 'properties' => $properties\n" .
 1938: 				"\t,\n";
 1939: 		}
 1940: 		$transforms_code .= "}\n";
 1941: 	}
 1942: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
●1943 → 1946 → 1963 1943: 	my $transform_properties_code = '';
 1944: 	my $use_properties = 0;
 1945: 
 1946: 	if (keys %transforms && ($config{properties}{enable} // 0)) {
 1947: 		$use_properties = 1;
 1948: 
 1949: 		# Generate property-based tests for transforms
 1950: 		my $properties = _generate_transform_properties(
 1951: 			\%transforms,
 1952: 			$function,
 1953: 			$module,
 1954: 			\%input,
 1955: 			\%config,
 1956: 			$new
 1957: 		);
 1958: 
 1959: 		# Convert to code for template
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1960: 		$transform_properties_code = _render_properties($properties);
 1961: 	}
 1962: 
●1963 → 1963 → 1984 1963: 	if(keys %accessor) {
 1964: 		# Sanity test
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1965: 		my $property = $accessor{property};
 1966: 		my $type = $accessor{type};
 1967: 
 1968: 		if(!defined($new)) {
 1969: 			# Internal invariant — schema has a contradictory accessor+type combination;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1970: 			# confess gives the full call chain to aid debugging
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1971: 			confess("invariant violation: $property: accessor $type can only work on an object, incorrectly tagged as $type");
 1972: 		}
 1973: 		if($type eq 'getset') {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1974: 			if(scalar(keys %input) != 1) {
 1975: 				confess("invariant violation: $property: getset must take one input argument, incorrectly tagged as getset");
 1976: 			}
 1977: 			if(scalar(keys %output) == 0) {
 1978: 				confess("invariant violation: $property: getset must give one output, incorrectly tagged as getset");
 1979: 			}
 1980: 		}
 1981: 	}
 1982: 
 1983: 	# Setup / call code (always load module)
●1984 → 1988 → 2056 1984: 	my $setup_code = ($module) ? "BEGIN { use_ok('$module') }" : '';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1985: 	my $call_code;	# Code to call the function being test when used with named arguments
 1986: 	my $position_code;	# Code to call the function being test when used with position arguments
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1987: 	my $has_positions = _has_positions(\%input);
 1988: 	if(defined($new) && defined($module)) {
 1989: 		# keep use_ok regardless (user found earlier issue)
 1990: 		if($new_code eq '') {
 1991: 			$new_code = "new_ok('$module')";
 1992: 		} else {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1992_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1993: 			$new_code = "new_ok('$module' => [ { $new_code } ] )";
 1994: 		}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1994_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1995: 		$setup_code .= "\nmy \$obj = $new_code;";

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1995_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1996: 		if($has_positions) {
 1997: 			$position_code = "\$result = (scalar(\@alist) == 1) ? \$obj->$function(\$alist[0]) : (scalar(\@alist) == 0) ? \$obj->$function() : \$obj->$function(\@alist);";
 1998: 			if(defined($accessor{type})) {
 1999: 				if($accessor{type} eq 'getter') {
 2000: 					$position_code .= "my \$prev_value = \$obj->{$accessor{property}};";
 2001: 				} elsif($accessor{type} eq 'getset') {
 2002: 					$position_code .= 'if(scalar(@alist) == 1) { ';

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2002_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2003: 					$position_code .= "cmp_ok(\$result, 'eq', \$alist[0], 'getset function returns what was put in'); ok(\$obj->$function() eq \$result, 'test getset accessor');";
 2004: 					$position_code .= '}';
 2005: 				}
 2006: 				if(($accessor{type} eq 'getset') || ($accessor{type} eq 'getter')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2006_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2007: 					# Since Perl doesn't support data encapsulation, we can test the getter returns the correct item
 2008: 					$position_code .= 'if(scalar(@alist) == 1) { ';
 2009: 					$position_code .= "cmp_ok(\$result, 'eq', \$obj->{$accessor{property}}, 'getset function returns correct item');";
 2010: 					if($accessor{type} eq 'getter') {
 2011: 						$position_code .= "if(defined(\$prev_value)) { cmp_ok(\$result, 'eq', \$prev_value, 'getter does not change value'); } ";

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2011_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2012: 					}
 2013: 					$position_code .= '}';
 2014: 				}
 2015: 				if($output{'_returns_self'}) {
 2016: 					croak("$accessor{type} for $accessor{property} cannot return \$self");
 2017: 				}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2018: 			}
 2019: 		} else {
 2020: 			$call_code = "\$result = \$obj->$function(\$input);";
 2021: 			if($output{'_returns_self'}) {
 2022: 				$call_code .= "ok(defined(\$result)); ok(\$result eq \$obj, '$function returns self')";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2023: 			} elsif(defined($accessor{type}) && ($accessor{type} eq 'getset')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2024: 				$call_code .= "ok(\$obj->$function() eq \$result, 'test getset accessor');"
 2025: 			}
 2026: 			if(scalar(keys %input) == 0) {
 2027: 				if(defined($accessor{type}) && ($accessor{type} eq 'getter')) {
 2028: 					$call_code .= "cmp_ok(\$result, 'eq', \$obj->{$accessor{property}}, 'getter function returns correct item') if(defined(\$result));";
 2029: 				}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2029_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2030: 			}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2030_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2031: 		}
 2032: 	} elsif(defined($module) && length($module)) {
 2033: 		if($function eq 'new') {
 2034: 			if($has_positions) {
 2035: 				$position_code = "\$result = (scalar(\@alist) == 1) ? ${module}\->$function(\$alist[0]) : (scalar(\@alist) == 0) ? ${module}\->$function() : ${module}\->$function(\@alist);";
 2036: 			} else {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2036_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2037: 				$call_code = "\$result = ${module}\->$function(\$input);";
 2038: 			}
 2039: 		} else {
 2040: 			if($has_positions) {
 2041: 				$position_code = "\$result = (scalar(\@alist) == 1) ? ${module}::$function(\$alist[0]) : (scalar(\@alist) == 0) ? ${module}::$function() : ${module}::$function(\@alist);";
 2042: 			} else {
 2043: 				$call_code = "\$result = ${module}::$function(\$input);";

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2043_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2044: 			}
 2045: 		}
 2046: 	} else {
 2047: 		if($has_positions) {
 2048: 			$position_code = "\$result = $function(\@alist);";
 2049: 		} else {
 2050: 			$call_code = "\$result = $function(\$input);";
 2051: 		}
 2052: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2053: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2054: 	# List-context capture: $result = func() in scalar context returns a count, not the list.
 2055: 	# When the schema says output type is 'array', capture into @_r then take a ref.
●2056 → 2056 → 2066 2056: 	if(($output{type} // '') eq 'array') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2056_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2057: 		if(defined($call_code)) {
 2058: 			$call_code =~ s/\A\$result = ([^;]+);/my \@_r = ($1); \$result = \\\@_r;/;
 2059: 		}
 2060: 		if(defined($position_code)) {
 2061: 			$position_code =~ s/\A\$result = ([^;]+);/my \@_r = ($1); \$result = \\\@_r;/;
 2062: 		}
 2063: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2064: 
 2065: 	# Build static corpus code
●2066 → 2067 → 2166 2066: 	my $corpus_code = '';
 2067: 	if (%all_cases) {
 2068: 		$corpus_code = "\n# --- Static Corpus Tests ---\n" .
 2069: 			"diag('Running " . scalar(keys %all_cases) . " corpus tests');\n";
 2070: 
 2071: 		for my $expected (sort keys %all_cases) {
 2072: 			my $inputs = $all_cases{$expected};
 2073: 			next unless($inputs);

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2073_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2074: 
 2075: 			my $expected_str = perl_quote($expected);
 2076: 			my $status = ((ref($inputs) eq 'HASH') && $inputs->{'_STATUS'}) // 'OK';
 2077: 			if($expected_str eq "'_STATUS:DIES'") {
 2078: 				$status = 'DIES';
 2079: 			} elsif($expected_str eq "'_STATUS:WARNS'") {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2080: 				$status = 'WARNS';
 2081: 			}
 2082: 
 2083: 			if(ref($inputs) eq 'HASH') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2083_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2084: 				$inputs = $inputs->{'input'};
 2085: 			}
 2086: 			my $input_str;
 2087: 			if(ref($inputs) eq 'ARRAY') {
 2088: 				$input_str = join(', ', map { perl_quote($_) } @{$inputs});
 2089: 			} elsif(ref($inputs) eq 'HASH') {
 2090: 				$input_str = render_fallback($inputs);
 2091: 
 2092: 				# YAML can't express Perl's undef, so a corpus value of
 2093: 				# the sentinel string 'undef' means "this param is
 2094: 				# undef" -- convert the quoted sentinel back to the
 2095: 				# bareword so the generated test passes real undef
 2096: 				$input_str =~ s/=> 'undef'/=> undef/gms;

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2096_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2097: 			} else {
 2098: 				$input_str = $inputs;
 2099: 			}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2099_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2100: 			if(($input_str eq 'undef') && (!$config{'test_undef'})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2100_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2101: 				carp('corpus case set to undef, yet test_undef is not set in config');
 2102: 			}
 2103: 			if($new) {
 2104: 				if($status eq 'DIES') {
 2105: 					$corpus_code .= "dies_ok { \$obj->$function($input_str) } " .
 2106: 							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") dies';\n";
 2107: 				} elsif($status eq 'WARNS') {
 2108: 					$corpus_code .= "warnings_exist { \$obj->$function($input_str) } qr/./, " .
 2109: 							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") warns';\n";
 2110: 				} else {
 2111: 					my $desc = sprintf("$function(%s) returns %s",

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2111_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2112: 						perl_quote(join(', ', map { $_ // '' } @$inputs )),

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2112_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2113: 						$expected_str
 2114: 					);
 2115: 					if(($output{'type'} // '') eq 'boolean') {
 2116: 						if($expected_str eq '1') {
 2117: 							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2118: 						} elsif($expected_str eq '0') {
 2119: 							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2120: 						} else {
 2121: 							croak("Boolean is expected to return $expected_str");
 2122: 						}
 2123: 					} else {
 2124: 						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2124_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2125: 					}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2125_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2126: 				}
 2127: 			} else {
 2128: 				if($status eq 'DIES') {
 2129: 					if($module) {
 2130: 						$corpus_code .= "dies_ok { $module\::$function($input_str) } " .
 2131: 							"'Corpus $expected dies';\n";
 2132: 					} else {
 2133: 						$corpus_code .= "dies_ok { $function($input_str) } " .

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2133_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2134: 							"'Corpus $expected dies';\n";
 2135: 					}
 2136: 				} elsif($status eq 'WARNS') {
 2137: 					if($module) {
 2138: 						$corpus_code .= "warnings_exist { $module\::$function($input_str) } qr/./, " .
 2139: 							"'Corpus $expected warns';\n";
 2140: 					} else {
 2141: 						$corpus_code .= "warnings_exist { $function($input_str) } qr/./, " .
 2142: 							"'Corpus $expected warns';\n";
 2143: 					}
 2144: 				} else {
 2145: 					my $desc = sprintf("$function(%s) returns %s",
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2146: 						perl_quote((ref $inputs eq 'ARRAY') ? (join(', ', map { $_ // '' } @{$inputs})) : $inputs),

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2146_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2147: 						$expected_str
 2148: 					);
 2149: 					if(($output{'type'} // '') eq 'boolean') {
 2150: 						if($expected_str eq '1') {
 2151: 							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2152: 						} elsif($expected_str eq '0') {
 2153: 							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2154: 						} else {
 2155: 							croak("Boolean is expected to return $expected_str");
 2156: 						}
 2157: 					} else {
 2158: 						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
 2159: 					}
 2160: 				}
 2161: 			}
 2162: 		}
 2163: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2164: 
 2165: 	# Prepare seed/iterations code fragment for the generated test
●2166 → 2167 → 2173 2166: 	my $seed_code = '';
 2167: 	if (defined $seed) {
 2168: 		# ensure integer-ish
 2169: 		$seed = int($seed);
 2170: 		$seed_code = "srand($seed);\n";
 2171: 	}
 2172: 
●2173 → 2211 → 0 2173: 	my $determinism_code = 'my $result2;' .
 2174: 		'eval { $result2 = do { ' . (defined($position_code) ? $position_code : $call_code) . " }; };\n" .
 2175: 		'is_deeply($result2, $result, "deterministic result for same input");' .
 2176: 		"\n";
 2177: 
 2178: 	# Generate the test content
 2179: 	my $tt = Template->new({ ENCODING => 'utf8', TRIM => 1 });
 2180: 
 2181: 	# Read template from DATA handle
 2182: 	my $template_package = __PACKAGE__ . '::Template';
 2183: 	my $template = $template_package->get_data_section('test.tt');
 2184: 
 2185: 	my $vars = {
 2186: 		setup_code => $setup_code,
 2187: 		edge_cases_code => $edge_cases_code,
 2188: 		edge_case_array_code => $edge_case_array_code,
 2189: 		type_edge_cases_code => $type_edge_cases_code,
 2190: 		config_code => $config_code,
 2191: 		seed_code => $seed_code,
 2192: 		input_code => $input_code,
 2193: 		output_code => $output_code,
 2194: 		transforms_code => $transforms_code,
 2195: 		corpus_code => $corpus_code,
 2196: 		call_code => $call_code,
 2197: 		position_code => $position_code,
 2198: 		determinism_code => $determinism_code,
 2199: 		function => $function,
 2200: 		iterations_code => int($iterations),
 2201: 		use_properties => $use_properties,
 2202: 		transform_properties_code => $transform_properties_code,
 2203: 		property_trials => $config{properties}{trials} // $DEFAULT_PROPERTY_TRIALS,
 2204: 		relationships_code => $relationships_code,
 2205: 		module => $module
 2206: 	};
 2207: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2208: 	my $test;
 2209: 	$tt->process($template, $vars, \$test) or croak($tt->error());
 2210: 
 2211: 	if ($test_file) {
 2212: 		# autodie is disabled for this open -- under "use autodie qw(:all)"
 2213: 		# open() never returns false on failure, it throws its own exception
 2214: 		# instead, which would silently make the "or croak" dead code.
 2215: 		no autodie qw(open);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2216: 		open my $fh, '>:encoding(UTF-8)', $test_file or croak "Cannot open $test_file: $!";
 2217: 		print $fh "$test\n";
 2218: 		close $fh;
 2219: 		if($module) {
 2220: 			print "Generated $test_file for $module\::$function with fuzzing + corpus support\n";
 2221: 		} else {
 2222: 			print "Generated $test_file for $function with fuzzing + corpus support\n";
 2223: 		}
 2224: 	} else {
 2225: 		print "$test\n";
 2226: 	}
 2227: }
 2228: 
 2229: # --- Helpers for rendering data structures into Perl code for the generated test ---
 2230: 
 2231: # --------------------------------------------------
 2232: # _is_perl_builtin
 2233: #
 2234: # Purpose:    Return true if a string is the name of
 2235: #             a Perl core builtin function, to prevent
 2236: #             it being used as a module name in
 2237: #             use_ok() calls in generated tests.
 2238: #
 2239: # Entry:      $name - the string to check.
 2240: # Exit:       Returns 1 if builtin, 0 otherwise.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2241: # --------------------------------------------------
 2242: sub _is_perl_builtin {
 2243: 	my $name = $_[0];
 2244: 	return 0 unless defined $name;
 2245: 
 2246: 	state %BUILTINS = map { $_ => 1 } qw(
 2247: 		abs accept alarm atan2 bind binmode bless
 2248: 		caller chdir chmod chomp chop chown chr chroot
 2249: 		close closedir connect cos crypt
 2250: 		dbmclose dbmopen defined delete die do dump
 2251: 		each endgrent endhostent endnetent endprotoent endpwent endservent
 2252: 		eof eval exec exists exit exp
 2253: 		fcntl fileno flock fork format formline
 2254: 		getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname
 2255: 		gethostent getlogin getnetbyaddr getnetbyname getnetent
 2256: 		getpeername getpgrp getppid getpriority getprotobyname
 2257: 		getprotobynumber getprotoent getpwent getpwnam getpwuid
 2258: 		getservbyname getservbyport getservent getsockname getsockopt
 2259: 		glob gmtime goto grep
 2260: 		hex
 2261: 		index int ioctl
 2262: 		join
 2263: 		keys kill
 2264: 		last lc lcfirst length link listen local localtime log lstat
 2265: 		map mkdir msgctl msgget msgrcv msgsnd my
 2266: 		next no
 2267: 		oct open opendir ord our
 2268: 		pack pipe pop pos print printf prototype push
 2269: 		quotemeta
 2270: 		rand read readdir readline readlink readpipe recv redo
 2271: 		ref rename require reset return reverse rewinddir rindex rmdir
 2272: 		say scalar seek seekdir select semctl semget semop send
 2273: 		setgrent sethostent setnetent setpgrp setpriority setprotoent
 2274: 		setpwent setservent setsockopt shift shmctl shmget shmread
 2275: 		shmwrite shutdown sin sleep socket socketpair sort splice split
 2276: 		sprintf sqrt srand stat study sub substr symlink syscall
 2277: 		sysopen sysread sysseek system syswrite
 2278: 		tell telldir tie tied time times truncate
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2279: 		uc ucfirst umask undef unlink unpack unshift untie use
 2280: 		utime values vec wait waitpid wantarray warn write
 2281: 	);
 2282: 	return $BUILTINS{lc $name} // 0;
 2283: }
 2284: 
 2285: # --------------------------------------------------
 2286: # _load_schema
 2287: #
 2288: # Load and parse a schema file using
 2289: #     Config::Abstraction, returning the
 2290: #     schema as a hashref.
 2291: #
 2292: # Entry:      $schema_file - path to the schema file.
 2293: #             Must be defined, non-empty, and readable.
 2294: #
 2295: # Exit:       Returns a hashref of the parsed schema
 2296: #             with a '_source' key added containing
 2297: #             the originating file path.
 2298: #             Croaks on any error.
 2299: #
 2300: # Side effects: Reads from the filesystem.
 2301: #
 2302: # Notes:      Legacy Perl-file configs (containing
 2303: #             '$module' or 'our $module' keys) are
 2304: #             rejected with a clear error. Config::
 2305: #             Abstraction is used rather than require()
 2306: #             to avoid executing arbitrary code from
 2307: #             user-supplied config files.
 2308: # --------------------------------------------------
 2309: sub _load_schema {
●2310 → 2324 → 2343 2310: 	my $schema_file = $_[0];
 2311: 
 2312: 	# Validate the argument before touching the filesystem
 2313: 	croak(__PACKAGE__, ': Usage: _load_schema($schema_file)') unless defined $schema_file;
 2314: 
 2315: 	croak(__PACKAGE__, ': _load_schema given empty filename') unless length($schema_file);
 2316: 
 2317: 	# Confirm the file exists and is readable before attempting
 2318: 	# to load it — gives a clearer error than Config::Abstraction would
 2319: 	croak(__PACKAGE__, ": _load_schema($schema_file): $!") unless -r $schema_file;
 2320: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2321: 	# Load configuration via Config::Abstraction which supports
 2322: 	# YAML, JSON, and other formats without executing arbitrary code.
 2323: 	# no_fixate prevents automatic type coercion that could alter values
 2324: 	if(my $schema = Config::Abstraction->new(
 2325: 		config_dirs  => ['.', ''],
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2326: 		config_file  => $schema_file,
 2327: 		no_fixate    => 1,
 2328: 	)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2329: 		if($schema = $schema->all()) {
 2330: 			# Detect legacy Perl config files by the presence of
 2331: 			# variable declaration keys — these are no longer supported
 2332: 			if(exists($schema->{$LEGACY_PERL_KEY_1}) ||
 2333: 			   exists($schema->{$LEGACY_PERL_KEY_2})) {
 2334: 				croak("$schema_file: Loading perl files as configs is no longer supported");
 2335: 			}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2336: 
 2337: 			# Tag the schema with its source path for error messages
 2338: 			$schema->{$SOURCE_KEY} = $schema_file;
 2339: 			return $schema;
 2340: 		}
 2341: 	}
 2342: 
 2343: 	croak "Failed to load schema from $schema_file";
 2344: }
 2345: 
 2346: # --------------------------------------------------
 2347: # _load_schema_section
 2348: #
 2349: # Purpose:    Extract a named section from a parsed
 2350: #             schema hashref, validating that it is
 2351: #             a hashref if present.
 2352: #
 2353: # Entry:      $schema      - the full parsed schema hashref.
 2354: #             $section     - name of the section to extract
 2355: #                            (e.g. 'input', 'output').
 2356: #             $schema_file - path of the schema file,
 2357: #                            used in error messages only.
 2358: #
 2359: # Exit:       Returns the section hashref if present,
 2360: #             or an empty hashref {} if absent.
 2361: #             Croaks if the section exists but is not
 2362: #             a hashref (and not the string 'undef').
 2363: #
 2364: # Notes:      The string 'undef' is treated as an
 2365: #             absent section — callers that set a
 2366: #             section to 'undef' in YAML get the same
 2367: #             result as omitting it entirely.
 2368: # --------------------------------------------------
 2369: sub _load_schema_section {
 2370: 	my ($schema, $section, $schema_file) = @_;
 2371: 
 2372: 	# Section absent — return empty hash as the safe default
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2373: 	return {} unless exists $schema->{$section};
 2374: 
 2375: 	# Section present and is a hashref — return it directly
 2376: 	return $schema->{$section}
 2377: 		if ref($schema->{$section}) eq 'HASH';
 2378: 
 2379: 	# Treat the YAML scalar 'undef' as equivalent to absent
 2380: 	return {}
 2381: 		if defined($schema->{$section}) &&
 2382: 		   $schema->{$section} eq 'undef';
 2383: 
 2384: 	# Section present but wrong type — croak with a clear message
 2385: 	# showing what type was found so the user can fix their schema
 2386: 	croak(
 2387: 		"$schema_file: $section should be a hash, not ",
 2388: 		ref($schema->{$section}) || $schema->{$section}
 2389: 	);
 2390: }
 2391: 
 2392: # --------------------------------------------------
 2393: # _validate_config
 2394: #
 2395: # Purpose:    Validate the top-level schema hashref
 2396: #             loaded from a schema file, checking that
 2397: #             required fields are present and that all
 2398: #             input parameters, types, positions, and
 2399: #             transform properties are well-formed.
 2400: #
 2401: # Entry:      $schema - the full parsed schema hashref
 2402: #             as returned by _load_schema().
 2403: #
 2404: # Exit:       Returns nothing on success.
 2405: #             Croaks on any structural error.
 2406: #             Carps on non-fatal warnings (unknown
 2407: #             semantic types, position gaps, missing
 2408: #             input/output definitions).
 2409: #
 2410: # Side effects: May delete $schema->{input} if its
 2411: #               value is the string 'undef'.
 2412: #
 2413: # Notes:      The parameter is named $schema throughout
 2414: #             to distinguish the top-level schema from
 2415: #             the nested config sub-hash. _validate_config
 2416: #             is called before _normalize_config so config
 2417: #             boolean normalisation has not yet occurred.
 2418: # --------------------------------------------------
 2419: sub _validate_config {
●2420 → 2424 → 2430 2420: 	my $schema = $_[0];
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2421: 
 2422: 	# At least one of module or function must be present —
 2423: 	# without these we cannot generate any meaningful test
 2424: 	if(!defined($schema->{'module'}) && !defined($schema->{'function'})) {
 2425: 		croak('At least one of function and module must be defined');
 2426: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2427: 
 2428: 	# Warn if neither input nor output is defined — a few
 2429: 	# generic tests can still be generated but it is unusual
●2430 → 2430 → 2435 2430: 	if(!defined($schema->{'input'}) && !defined($schema->{'output'})) {
 2431: 		carp('Neither input nor output is defined, only a few tests will be generated');
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2432: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2433: 
 2434: 	# Normalise input: the string 'undef' means no input defined
●2435 → 2435 → 2444 2435: 	if($schema->{'input'} && ref($schema->{input}) ne 'HASH') {
 2436: 		if($schema->{'input'} eq 'undef') {
 2437: 			delete $schema->{'input'};
 2438: 		} else {
 2439: 			croak("Invalid input specification: expected hash, got '$schema->{'input'}'");
 2440: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2441: 	}
 2442: 
 2443: 	# Validate each input parameter if input is defined
●2444 → 2444 → 2451 2444: 	if($schema->{input}) {
 2445: 		_validate_input_params($schema);
 2446: 		_validate_input_positions($schema);
 2447: 		_validate_input_semantics($schema);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2448: 	}
 2449: 
 2450: 	# Validate transform property definitions if present
●2451 → 2451 → 2456 2451: 	if(exists($schema->{transforms}) && ref($schema->{transforms}) eq 'HASH') {
 2452: 		_validate_transform_properties($schema);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2453: 	}
 2454: 
 2455: 	# Validate any nested config sub-hash keys against known types
●2456 → 2456 → 0 2456: 	if(ref($schema->{config}) eq 'HASH') {
 2457: 		for my $k (keys %{$schema->{'config'}}) {
 2458: 			# %VALID_CONFIG_KEYS is the authoritative set — O(1) hash lookup
 2459: 			croak "unknown config setting '$k'"
 2460: 				unless $VALID_CONFIG_KEYS{$k};
 2461: 		}
 2462: 	}
 2463: }
 2464: 
 2465: # --------------------------------------------------
 2466: # _validate_input_params
 2467: #
 2468: # Purpose:    Validate type specifications for each
 2469: #             named input parameter.
 2470: #
 2471: # Entry:      $schema - the full parsed schema hashref.
 2472: #             $schema->{input} must be a hashref.
 2473: #
 2474: # Exit:       Returns nothing. Croaks on invalid type.
 2475: # --------------------------------------------------
 2476: sub _validate_input_params {
●2477 → 2479 → 0 2477: 	my $schema = $_[0];
 2478: 
 2479: 	for my $param (keys %{$schema->{input}}) {
 2480: 		# Catch empty parameter names — these would produce
 2481: 		# broken Perl variable names in the generated test
 2482: 		croak 'Empty input parameter name'
 2483: 			unless length($param);
 2484: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2485: 		my $spec = $schema->{input}{$param};
 2486: 
 2487: 		# Validate the type field — required for all parameters
 2488: 		if(ref($spec)) {
 2489: 			croak("Missing type for parameter '$param'")
 2490: 				unless defined $spec->{type};
 2491: 			# 'coderef' is a SchemaExtractor-specific type; treat as 'any'
 2492: 			$spec->{type} = 'any' if $spec->{type} eq 'coderef';
 2493: 			croak("Invalid type '$spec->{type}' for parameter '$param'")
 2494: 				unless _valid_type($spec->{type});
 2495: 		} else {
 2496: 			croak("Invalid type '$spec' for parameter '$param'")
 2497: 				unless _valid_type($spec);
 2498: 		}
 2499: 	}
 2500: }
 2501: 
 2502: # --------------------------------------------------
 2503: # _validate_input_positions
 2504: #
 2505: # Purpose:    Validate positional argument declarations
 2506: #             in the input schema — positions must be
 2507: #             non-negative integers with no duplicates,
 2508: #             and either all or no parameters must have
 2509: #             positions.
 2510: #
 2511: # Entry:      $schema - the full parsed schema hashref.
 2512: #             $schema->{input} must be a hashref.
 2513: #
 2514: # Exit:       Returns nothing. Croaks on invalid or
 2515: #             duplicate positions. Carps on gaps.
 2516: # --------------------------------------------------
 2517: sub _validate_input_positions {
●2518 → 2523 → 2544 2518: 	my $schema = $_[0];
 2519: 
 2520: 	my $has_positions = 0;
 2521: 	my %positions;
 2522: 
 2523: 	for my $param (keys %{$schema->{input}}) {
 2524: 		my $spec = $schema->{input}{$param};
 2525: 
 2526: 		# Only process params that explicitly declare a position
 2527: 		next unless ref($spec) eq 'HASH' && defined($spec->{position});
 2528: 
 2529: 		$has_positions = 1;
 2530: 		my $pos = $spec->{position};
 2531: 
 2532: 		# Position must be a non-negative integer
 2533: 		croak "Position for '$param' must be a non-negative integer"
 2534: 			unless $pos =~ /^\d+$/;
 2535: 
 2536: 		# Duplicate positions would produce ambiguous generated tests
 2537: 		croak "Duplicate position $pos for parameters '$positions{$pos}' and '$param'"
 2538: 			if exists $positions{$pos};
 2539: 
 2540: 		$positions{$pos} = $param;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2541: 	}
 2542: 
 2543: 	# If any param has a position, all params must have one
  Mutants (Total: 1, Killed: 1, Survived: 0)
●2544 → 2544 → 0 2544: 	if($has_positions) {
 2545: 		for my $param (keys %{$schema->{input}}) {
 2546: 			my $spec = $schema->{input}{$param};
 2547: 			unless(ref($spec) eq 'HASH' && defined($spec->{position})) {
 2548: 				croak "Parameter '$param' missing position " .
 2549: 					'(all params must have positions if any do)';
 2550: 			}
 2551: 		}
 2552: 
 2553: 		# Check for gaps — positions must be a contiguous sequence
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2554: 		# starting at 0, otherwise the generated test will be wrong
 2555: 		my @sorted = sort { $a <=> $b } keys %positions;
 2556: 		for my $i (0 .. $#sorted) {
 2557: 			if($sorted[$i] != $i) {
 2558: 				carp "Position sequence has gaps (positions: @sorted)";
 2559: 				last;
 2560: 			}
 2561: 		}
 2562: 	}
 2563: }
 2564: 
 2565: # --------------------------------------------------
 2566: # _validate_input_semantics
 2567: #
 2568: # Purpose:    Validate semantic type annotations and
 2569: #             enum/memberof constraints on input params.
 2570: #
 2571: # Entry:      $schema - the full parsed schema hashref.
 2572: #             $schema->{input} must be a hashref.
 2573: #
 2574: # Exit:       Returns nothing. Croaks on conflicting
 2575: #             or malformed enum/memberof. Carps on
 2576: #             unknown semantic types.
 2577: # --------------------------------------------------
 2578: sub _validate_input_semantics {
●2579 → 2583 → 0 2579: 	my $schema = $_[0];
 2580: 
 2581: 	my $semantic_generators = _get_semantic_generators();
 2582: 
 2583: 	for my $param (keys %{$schema->{input}}) {
 2584: 		my $spec = $schema->{input}{$param};
 2585: 		next unless ref($spec) eq 'HASH';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2586: 
 2587: 		# Warn on unknown semantic types rather than croaking —
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2588: 		# new semantic types may be added without updating this list
 2589: 		if(defined($spec->{semantic})) {
 2590: 			my $semantic = $spec->{semantic};
 2591: 			unless(exists $semantic_generators->{$semantic}) {
 2592: 				carp "Unknown semantic type '$semantic' for parameter '$param'. " .
 2593: 					'Available types: ' .
 2594: 					join(', ', sort keys %{$semantic_generators});
 2595: 			}
 2596: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2597: 
 2598: 		# enum and memberof are mutually exclusive representations
 2599: 		# of the same concept — having both is always a schema error
 2600: 		if($spec->{'enum'} && $spec->{'memberof'}) {
 2601: 			croak "$param: has both enum and memberof";
 2602: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2603: 
 2604: 		# Both enum and memberof must be arrayrefs when present
 2605: 		for my $type ('enum', 'memberof') {
 2606: 			if(exists $spec->{$type}) {
 2607: 				croak "$type must be an arrayref"
 2608: 					unless ref($spec->{$type}) eq 'ARRAY';
 2609: 			}
 2610: 		}
 2611: 	}
 2612: }
 2613: 
 2614: # --------------------------------------------------
 2615: # _validate_transform_properties
 2616: #
 2617: # Purpose:    Validate the properties array in each
 2618: #             transform definition, checking that each
 2619: #             property is either a known builtin name
 2620: #             or a custom hashref with name and code.
 2621: #
 2622: # Entry:      $schema - the full parsed schema hashref.
 2623: #             $schema->{transforms} must be a hashref.
 2624: #
 2625: # Exit:       Returns nothing. Croaks on invalid property
 2626: #             definitions. Carps on unknown builtins.
 2627: # --------------------------------------------------
 2628: sub _validate_transform_properties {
●2629 → 2633 → 0 2629: 	my $schema = $_[0];
 2630: 
 2631: 	my $builtin_props = _get_builtin_properties();
 2632: 
 2633: 	for my $transform_name (keys %{$schema->{transforms}}) {
 2634: 		my $transform = $schema->{transforms}{$transform_name};
 2635: 
 2636: 		# properties is optional — skip transforms that don't define it
 2637: 		next unless exists $transform->{properties};
 2638: 
 2639: 		croak "Transform '$transform_name': properties must be an array"
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2640: 			unless ref($transform->{properties}) eq 'ARRAY';
 2641: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2642: 		for my $prop (@{$transform->{properties}}) {
 2643: 			if(!ref($prop)) {
 2644: 				# Plain string — must be a known builtin property name
 2645: 				unless(exists $builtin_props->{$prop}) {
 2646: 					carp "Transform '$transform_name': unknown built-in property '$prop'. " .
 2647: 						'Available: ' .
 2648: 						join(', ', sort keys %{$builtin_props});
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2649: 				}
 2650: 			} elsif(ref($prop) eq 'HASH') {
 2651: 				# Custom property — must have both name and code fields
 2652: 				unless($prop->{name} && $prop->{code}) {
 2653: 					croak "Transform '$transform_name': " .
 2654: 						"custom properties must have 'name' and 'code' fields";
 2655: 				}
 2656: 			} else {
 2657: 				croak "Transform '$transform_name': invalid property definition";
 2658: 			}
 2659: 		}
 2660: 	}
 2661: }
 2662: 
 2663: # --------------------------------------------------
 2664: # _normalize_config
 2665: #
 2666: # Purpose:    Normalise boolean string values in the
 2667: #             config sub-hash to Perl integers (1/0),
 2668: #             and default absent boolean fields to 1
 2669: #             (enabled). The 'properties' field is a
 2670: #             hashref not a boolean and is handled
 2671: #             separately.
 2672: #
 2673: # Entry:      $config - the config sub-hash extracted
 2674: #             from the schema (i.e. $schema->{config}).
 2675: #             May be empty.
 2676: #
 2677: # Exit:       Returns nothing. Modifies $config in place.
 2678: #
 2679: # Side effects: Modifies the caller's config hashref.
 2680: #
 2681: # Notes:      String-to-boolean conversion is delegated
 2682: #             to %Readonly::Values::Boolean::booleans
 2683: #             which handles 'yes'/'no', 'on'/'off',
 2684: #             'true'/'false' etc. Fields not present in
 2685: #             the config hash are defaulted to 1 so
 2686: #             that test generation is maximally thorough
 2687: #             unless the schema explicitly disables a
 2688: #             feature.
 2689: # --------------------------------------------------
 2690: sub _normalize_config {
●2691 → 2693 → 2714 2691: 	my $config = $_[0];
 2692: 
 2693: 	for my $field (keys %VALID_CONFIG_KEYS) {
 2694: 		# Non-boolean fields are handled separately
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2695: 		next if $field eq $CONFIG_PROPERTIES_KEY;
 2696: 		next if $field eq 'timeout';	# numeric, not boolean; absence means use generated-test default
 2697: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2698: 		if(exists($config->{$field}) && defined($config->{$field})) {
 2699: 			# Convert string boolean representations to integers
 2700: 			# using the lookup table from Readonly::Values::Boolean
 2701: 			if(defined(my $b = $Readonly::Values::Boolean::booleans{$config->{$field}})) {
 2702: 				$config->{$field} = $b;
 2703: 			}
 2704: 		} else {
 2705: 			# Default absent boolean fields to enabled (1) so that
 2706: 			# test generation is comprehensive unless explicitly disabled
 2707: 			$config->{$field} = 1;
 2708: 		}
 2709: 	}
 2710: 
 2711: 	# Ensure properties is always a hashref — if absent or set to
 2712: 	# a non-hash value, replace with a disabled default so that
 2713: 	# downstream code can safely dereference it without checking ref()
 2714: 	$config->{$CONFIG_PROPERTIES_KEY} = { enable => 0 } unless ref($config->{$CONFIG_PROPERTIES_KEY}) eq 'HASH';
 2715: }
 2716: 
 2717: # --------------------------------------------------
 2718: # _valid_type
 2719: #
 2720: # Determine whether a string is a
 2721: #     recognised schema field type accepted
 2722: #     by the generator.
 2723: #
 2724: # Entry:      $type - the type string to validate.
 2725: #             May be undef.
 2726: #
 2727: # Exit:       Returns 1 if the type is known,
 2728: #             0 if the type is unknown or undef.
 2729: #
 2730: # Notes:      The lookup hash is declared with
 2731: #             'state' so it is built only once per
 2732: #             process rather than on every call —
 2733: #             important since _valid_type is called
 2734: #             in a loop over all input parameters.
 2735: #
 2736: #             'int' and 'bool' are accepted as
 2737: #             aliases for 'integer' and 'boolean'
 2738: #             respectively, for compatibility with
 2739: #             schemas generated by external tools
 2740: #             that use the shorter forms.
 2741: # --------------------------------------------------
 2742: sub _valid_type {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2743: 	my $type = $_[0];
 2744: 
 2745: 	# Undef is never a valid type
 2746: 	return 0 unless defined($type);
 2747: 
 2748: 	# Build the lookup table once and cache it for
 2749: 	# the lifetime of the process via 'state'
 2750: 	state %VALID = map { $_ => 1 } qw(
 2751: 		string boolean integer number float
 2752: 		hashref arrayref object int bool any
 2753: 	);
 2754: 
 2755: 	return($VALID{$type} // 0);
 2756: }
 2757: 
 2758: # --------------------------------------------------
 2759: # _assert_identifier
 2760: #
 2761: # Purpose:    Validate that a string is shaped like a
 2762: #             plain Perl identifier (or, with
 2763: #             package => 1, a "::"-separated package
 2764: #             name) before it is spliced into generated
 2765: #             test source as a bareword, package name,
 2766: #             method name, or variable name rather than
 2767: #             a quoted string literal. Schema-derived
 2768: #             names (module, function, transform names)
 2769: #             are spliced unescaped at the call sites
 2770: #             that use this guard, so an unvalidated
 2771: #             name could otherwise break out of the
 2772: #             generated source and inject arbitrary
 2773: #             Perl into a file that L<prove> will run.
 2774: #
 2775: # Entry:      $name - the string to validate.
 2776: #             $what - short label for the value, used
 2777: #                     only in the croak message.
 2778: #             %opts - package => 1 allows "::"
 2779: #                     separators in $name.
 2780: #
 2781: # Exit:       Returns $name unchanged on success.
 2782: #             Croaks if $name is not identifier-shaped.
 2783: # --------------------------------------------------
 2784: sub _assert_identifier {
 2785: 	my ($name, $what, %opts) = @_;
 2786: 
 2787: 	croak(__PACKAGE__, ": $what is missing or empty")
 2788: 		unless defined($name) && length($name);
 2789: 
 2790: 	my $re = $opts{package}
 2791: 		? qr/^[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/
 2792: 		: qr/^[A-Za-z_]\w*\z/;
 2793: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2794: 	croak(__PACKAGE__, ": $what '$name' is not a valid Perl identifier")
 2795: 		unless $name =~ $re;
 2796: 
 2797: 	return $name;
 2798: }
 2799: 
 2800: # --------------------------------------------------
 2801: # _validate_module
 2802: #
 2803: # Purpose:    Check whether the module named in a
 2804: #             schema can be found in @INC during
 2805: #             test generation. Optionally also
 2806: #             attempts to load it if the
 2807: #             GENERATOR_VALIDATE_LOAD environment
 2808: #             variable is set.
 2809: #
 2810: # Entry:      $module      - the module name to
 2811: #                            check. If undef or
 2812: #                            empty, returns 1
 2813: #                            immediately (builtin
 2814: #                            functions need no
 2815: #                            module).
 2816: #             $schema_file - path to the schema
 2817: #                            file, used in warning
 2818: #                            messages only.
 2819: #
 2820: # Exit:       Returns 1 if the module was found
 2821: #             (and loaded, if validation was
 2822: #             requested).
 2823: #             Returns 0 if the module was not
 2824: #             found or failed to load — this is
 2825: #             non-fatal; generation continues.
 2826: #             Returns 1 immediately for undef or
 2827: #             empty $module.
 2828: #
 2829: # Side effects: Prints to STDERR when TEST_VERBOSE
 2830: #               or GENERATOR_VERBOSE is set.
 2831: #               Carps (non-fatally) when the module
 2832: #               cannot be found or loaded.
 2833: #               May attempt to load the module into
 2834: #               the current process when
 2835: #               GENERATOR_VALIDATE_LOAD is set —
 2836: #               this can have side effects depending
 2837: #               on the module.
 2838: #
 2839: # Notes:      Not finding a module during generation
 2840: #             is intentionally non-fatal — the module
 2841: #             may be available on the target machine
 2842: #             even if not on the generation machine.
 2843: #             Verbose output goes to STDERR via
 2844: #             print rather than carp since it is
 2845: #             informational, not a warning.
 2846: # --------------------------------------------------
 2847: sub _validate_module {
  Mutants (Total: 2, Killed: 2, Survived: 0)
●2848 → 2856 → 2869 2848: 	my ($module, $schema_file) = @_;
 2849: 
 2850: 	# Builtin functions have no module to validate
 2851: 	return 1 unless $module;
 2852: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2853: 	# Check whether the module is findable in @INC
 2854: 	my $mod_info = check_install(module => $module);
 2855: 
 2856: 	if($schema_file && !$mod_info) {
 2857: 		# Non-fatal — emit a single consolidated warning so
 2858: 		# the caller sees one message rather than four
 2859: 		carp(
 2860: 			"Module '$module' not found in \@INC during generation.\n" .
 2861: 			"  Config file: $schema_file\n" .
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2862: 			"  This is OK if the module will be available when tests run.\n" .
 2863: 			'  If unexpected, check your module name and installation.'
 2864: 		);
 2865: 		return 0;
 2866: 	}
 2867: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2868: 	# Check once and reuse — avoids evaluating two env vars twice
●2869 → 2871 → 2880 2869: 	my $verbose = $ENV{$ENV_TEST_VERBOSE} || $ENV{$ENV_GENERATOR_VERBOSE};
 2870: 
 2871: 	if($verbose) {
 2872: 		carp "Found module '$module' at: $mod_info->{'file'} " .
 2873: 			'(version ' . ($mod_info->{'version'} || 'unknown') . ')';
 2874: 	}
 2875: 
 2876: 	# Optional load validation — disabled by default because

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2876_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2877: 	# loading a module can have side effects (e.g. BEGIN blocks,
 2878: 	# database connections, file I/O) that are undesirable
 2879: 	# during generation

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2879_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●2880 → 2880 → 2897 2880: 	if($ENV{$ENV_VALIDATE_LOAD}) {
 2881: 		my $loaded = can_load(modules => { $module => undef }, verbose => 0);
 2882: 
 2883: 		if(!$loaded) {
 2884: 			my $err = $Module::Load::Conditional::ERROR || 'unknown error';
 2885: 			carp(

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_2885_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2885_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2886: 				"Module '$module' found but failed to load: $err\n" .
 2887: 				'  This might indicate a broken installation or missing dependencies.'
 2888: 			);

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2888_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2889: 			return 0;
 2890: 		}
 2891: 
 2892: 		if($verbose) {
 2893: 			carp "Successfully loaded module '$module'";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2894: 		}
 2895: 	}
 2896: 
 2897: 	return 1;
 2898: }
 2899: 
 2900: =head2 render_fallback
 2901: 
 2902: Render any Perl value into a compact Perl source-code string using
 2903: L<Data::Dumper>. Used as a catch-all when no more specific renderer
 2904: applies.
 2905: 
 2906:     my $code = render_fallback({ key => 'value' });
 2907:     # returns: "{'key' => 'value'}"
 2908: 
 2909: =head3 Arguments
 2910: 
 2911: =over 4
 2912: 
 2913: =item * C<$v>
 2914: 
 2915: Any Perl value, including undef, scalars, refs, and blessed objects.
 2916: 
 2917: =back
 2918: 
 2919: =head3 Returns
 2920: 
 2921: A string of Perl source code that reproduces the value when evaluated.
 2922: Returns the string C<'undef'> when C<$v> is undef.
 2923: 
 2924: =head3 Side effects
 2925: 
 2926: Temporarily sets C<$Data::Dumper::Terse> and C<$Data::Dumper::Indent>
 2927: to produce compact single-line output. Both are restored on return via
 2928: C<local>.
 2929: 
 2930: =head3 Notes
 2931: 
 2932: The output is always a single line with no trailing newline. Suitable
 2933: for embedding in generated test code where readability is secondary to
 2934: correctness.
 2935: 
 2936: =head3 API specification
 2937: 
 2938: =head4 input
 2939: 
 2940:     { v => { type => 'any', optional => 1 } }
 2941: 
 2942: =head4 output
 2943: 
 2944:     { type => 'string' }
 2945: 
 2946: =cut
 2947: 
 2948: sub render_fallback {
 2949: 	my $v = $_[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2950: 
 2951: 	# Handle undef explicitly rather than letting Dumper produce
 2952: 	# 'undef' without the localised settings applied
 2953: 	return 'undef' unless defined $v;
 2954: 
 2955: 	# Use Terse+Indent=0 to produce compact single-line output
 2956: 	# suitable for embedding in generated test code
 2957: 	local $Data::Dumper::Terse  = 1;
 2958: 	local $Data::Dumper::Indent = 0;
 2959: 
 2960: 	my $s = Dumper($v);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2961: 
 2962: 	# Remove trailing newline that Dumper always appends
 2963: 	chomp $s;
 2964: 	return $s;
 2965: }
 2966: 
 2967: =head2 render_hash
 2968: 
 2969: Render a two-level hashref (parameter name => spec hashref) into Perl
 2970: source code suitable for embedding in a generated test file as the
 2971: input specification passed to L<Params::Validate::Strict>.
 2972: 
 2973:     my $code = render_hash(\%input);
 2974: 
 2975: =head3 Arguments
 2976: 
 2977: =over 4
 2978: 
 2979: =item * C<$href>
 2980: 
 2981: A hashref whose values are themselves hashrefs containing field
 2982: specifications. A scalar value that is a recognised type string (see
 2983: C<_valid_type>) is expanded to C<{ type =E<gt> $value }>. Any other
 2984: non-hashref value is skipped with a warning.
 2985: 
 2986: =back
 2987: 
 2988: =head3 Returns
 2989: 
 2990: A string of comma-separated Perl source-code lines, one per key, of
 2991: the form:
 2992: 
 2993:     'key' => { subkey => value, ... }
 2994: 
 2995: Returns an empty string if C<$href> is undef, empty, or not a hashref.
 2996: 
 2997: =head3 Notes
 2998: 
 2999: The C<matches> and C<nomatch> sub-keys are treated specially — their
 3000: values are compiled to C<Regexp> objects via C<eval { qr/.../ }> and
 3001: then rendered using C<perl_quote> so they appear as C<qr{...}> in the
 3002: generated test. This prevents unmatched bracket characters in the
 3003: pattern from causing compilation failures.
 3004: 
 3005: Other sub-keys are rendered via C<perl_quote>.
 3006: 
 3007: =head3 API specification
 3008: 
 3009: =head4 input
 3010: 
 3011:     { href => { type => 'any', optional => 1 } }
 3012: 
 3013: =head4 output
 3014: 
 3015:     { type => 'string' }
 3016: 
 3017: =cut
 3018: 
 3019: sub render_hash {
●3020 → 3028 → 3086 3020: 	my $href = $_[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3021: 
 3022: 	# Return empty string for absent or non-hash input — callers
 3023: 	# treat '' as "no input specification" in the generated test
 3024: 	return '' unless $href && ref($href) eq 'HASH';
 3025: 
 3026: 	my @lines;
 3027: 
 3028: 	for my $k (sort keys %{$href}) {
 3029: 		my $def = $href->{$k};
 3030: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3031: 		# Handle scalar shorthand — 'arg1: string' is equivalent to
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3032: 		# 'arg1: { type: string }' and is explicitly supported by the
 3033: 		# validation layer in _validate_input_params
 3034: 		unless(defined($def) && ref($def) eq 'HASH') {
 3035: 			if(defined($def) && !ref($def) && _valid_type($def)) {
 3036: 				# Expand scalar type shorthand to a full spec hashref
 3037: 				$def = { type => $def };
 3038: 			} else {
 3039: 				carp "render_hash: skipping key '$k' — value is not a hashref or recognised type string";
 3040: 				next;
 3041: 			}
 3042: 		}
 3043: 
 3044: 		my @pairs;
 3045: 
 3046: 		for my $subk (sort keys %{$def}) {
 3047: 			# Skip undef sub-values — they contribute nothing to the spec
 3048: 			next unless defined $def->{$subk};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3049: 

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_3049_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 3050: 			# Validate that reference types are ones we can render —
 3051: 			# nested hashrefs are not yet supported
 3052: 			if(ref($def->{$subk})) {
 3053: 				unless((ref($def->{$subk}) eq 'ARRAY') ||
 3054: 				       (ref($def->{$subk}) eq 'Regexp')) {
 3055: 					croak(
 3056: 						__PACKAGE__,
 3057: 						": $subk is a nested element, not yet supported (",
 3058: 						ref($def->{$subk}), ')'
 3059: 					);
 3060: 				}
 3061: 			}
 3062: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3063: 			# matches and nomatch values must be Regexp objects in the
 3064: 			# generated test — compile raw strings safely via eval so
 3065: 			# patterns containing [ or \ don't cause compile failures
 3066: 			if(($subk eq $KEY_MATCHES) || ($subk eq $KEY_NOMATCH)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3067: 				my $re = ref($def->{$subk}) eq 'Regexp'
 3068: 					? $def->{$subk}
 3069: 					: eval { qr/$def->{$subk}/ };
 3070: 				if($@ || !defined($re)) {
 3071: 					carp "render_hash: invalid $subk pattern '$def->{$subk}': $@";
 3072: 					next;
 3073: 				}
 3074: 				push @pairs, "$subk => " . perl_quote($re);
 3075: 			} else {
 3076: 				# All other sub-keys are rendered via perl_quote which
 3077: 				# handles scalars, arrayrefs, and Regexp objects correctly
 3078: 				push @pairs, "$subk => " . perl_quote($def->{$subk});
 3079: 			}
 3080: 		}
 3081: 
 3082: 		# Use "\t" rather than a literal tab for clarity and grep-ability
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3083: 		push @lines, "\t" . perl_quote($k) . ' => { ' . join(', ', @pairs) . ' }';
 3084: 	}
 3085: 
 3086: 	return join(",\n", @lines);
 3087: }
 3088: 
 3089: =head2 render_args_hash
 3090: 
 3091: Render a flat hashref into a Perl source-code argument list of the
 3092: form C<'key' => value, ...>, suitable for embedding in a function call
 3093: in a generated test file.
 3094: 
 3095:     my $code = render_args_hash({ type => 'string', min => 1 });
 3096:     # returns: "'min' => 1, 'type' => 'string'"
 3097: 
 3098: =head3 Arguments
 3099: 
 3100: =over 4
 3101: 
 3102: =item * C<$href>
 3103: 
 3104: A flat hashref of key-value pairs. Values may be scalars, arrayrefs,
 3105: or Regexp objects — all are handled by C<perl_quote>.
 3106: 
 3107: =back
 3108: 
 3109: =head3 Returns
 3110: 
 3111: A comma-separated string of C<key => value> pairs sorted by key.
 3112: Returns an empty string if C<$href> is undef, empty, or not a hashref.
 3113: 
 3114: =head3 Notes
 3115: 
 3116: Keys and values are both rendered via C<perl_quote>. In particular,
 3117: C<Regexp> values are rendered as C<qr{...}> which is correct for
 3118: L<Params::Validate::Strict> and L<Return::Set> schema arguments in
 3119: the generated test.
 3120: 
 3121: =head3 API specification
 3122: 
 3123: =head4 input
 3124: 
 3125:     { href => { type => 'any', optional => 1 } }
 3126: 
 3127: =head4 output
 3128: 
 3129:     { type => 'string' }
 3130: 
 3131: =cut
 3132: 
 3133: sub render_args_hash {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3134: 	my $href = $_[0];
 3135: 
 3136: 	# Return empty string for absent or non-hash input
 3137: 	return '' unless $href && ref($href) eq 'HASH';
 3138: 
 3139: 	# Sort keys for deterministic output across runs — important for
 3140: 	# generated test files that are committed to version control
 3141: 	my @pairs = map {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3142: 		perl_quote($_) . ' => ' . perl_quote($href->{$_})
 3143: 	} sort keys %{$href};
 3144: 
 3145: 	return join(', ', @pairs);
 3146: }
 3147: 
 3148: =head2 render_arrayref_map
 3149: 
 3150: Render a hashref whose values are arrayrefs into a Perl source-code
 3151: fragment suitable for use as a hash literal in a generated test file.
 3152: 
 3153:     my $code = render_arrayref_map({ name => ['', 'a' x 100] });
 3154: 
 3155: =head3 Arguments
 3156: 
 3157: =over 4
 3158: 
 3159: =item * C<$href>
 3160: 
 3161: A hashref whose values are arrayrefs. Keys whose values are not
 3162: arrayrefs are silently skipped.
 3163: 
 3164: =back
 3165: 
 3166: =head3 Returns
 3167: 
 3168: A comma-separated string of C<'key' => [ val, ... ]> entries, one per
 3169: qualifying key, sorted alphabetically. Returns the string C<'()'> if
 3170: C<$href> is undef, empty, or not a hashref — this produces an empty
 3171: hash assignment in the generated test rather than a syntax error.
 3172: 
 3173: =head3 Notes
 3174: 
 3175: Array element values are rendered via C<perl_quote> which handles
 3176: scalars, arrayrefs, and Regexp objects. Non-arrayref values are
 3177: skipped without warning — this is intentional since callers may pass
 3178: mixed-value hashes and only want the arrayref entries rendered.
 3179: 
 3180: =head3 API specification
 3181: 
 3182: =head4 input
 3183: 
 3184:     { href => { type => 'any', optional => 1 } }
 3185: 
 3186: =head4 output
 3187: 
 3188:     { type => 'string' }
 3189: 
 3190: =cut
 3191: 
 3192: sub render_arrayref_map {
●3193 → 3201 → 3215 3193: 	my $href = $_[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3194: 
 3195: 	# Return '()' rather than '' so callers get a valid empty hash
 3196: 	# literal rather than a syntax error in the generated test
 3197: 	return '()' unless $href && ref($href) eq 'HASH';
 3198: 
 3199: 	my @entries;
 3200: 
 3201: 	for my $k (sort keys %{$href}) {
 3202: 		my $aref = $href->{$k};
 3203: 
 3204: 		# Skip non-arrayref values — mixed hashes are allowed by callers
 3205: 		next unless ref($aref) eq 'ARRAY';
 3206: 
 3207: 		# Render each array element via perl_quote so strings are
 3208: 		# properly quoted and numbers are left unquoted
 3209: 		my $vals = join(', ', map { perl_quote($_) } @{$aref});
 3210: 
 3211: 		# Use "\t" rather than a literal tab for clarity
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3212: 		push @entries, "\t" . perl_quote($k) . " => [ $vals ]";
 3213: 	}
 3214: 
 3215: 	return join(",\n", @entries);
 3216: }
 3217: 
 3218: # --------------------------------------------------
 3219: # _has_positions
 3220: #
 3221: # Purpose:    Determine whether any field in an input
 3222: #             spec hashref declares a positional argument
 3223: #             via the 'position' key.
 3224: #
 3225: # Entry:      $input_spec - the input section of a parsed
 3226: #             schema, expected to be a hashref whose values
 3227: #             are themselves hashrefs containing field specs.
 3228: #             May be undef or a non-hash ref.
 3229: #
 3230: # Exit:       Returns 1 if any field has a defined
 3231: #             'position' key, 0 otherwise.
 3232: #
 3233: # Notes:      Returns 0 immediately for undef or non-hash
 3234: #             input rather than throwing — callers use the
 3235: #             return value as a boolean and do not expect
 3236: #             exceptions from this function.
 3237: # --------------------------------------------------
 3238: sub _has_positions {
  Mutants (Total: 2, Killed: 2, Survived: 0)
●3239 → 3244 → 3254 3239: 	my $input_spec = $_[0];
 3240: 
 3241: 	# Guard against undef or non-hash input — keys %$undef would throw
 3242: 	return 0 unless defined($input_spec) && ref($input_spec) eq 'HASH';
 3243: 
 3244: 	for my $field (keys %{$input_spec}) {
 3245: 		# Only examine fields whose spec is a hashref — scalar specs
 3246: 		# (e.g. input: { type: string }) cannot have positions
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3247: 		next unless ref($input_spec->{$field}) eq 'HASH';
 3248: 
 3249: 		# Return immediately on first match — no need to scan further
 3250: 		return 1 if defined $input_spec->{$field}{position};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3251: 	}
 3252: 
 3253: 	# No positional arguments found in any field
 3254: 	return 0;
 3255: }
 3256: 
 3257: # --------------------------------------------------
 3258: # q_wrap
 3259: #
 3260: # Purpose:    Wrap a string in the most readable
 3261: #             q{} form that does not require escaping,
 3262: #             falling back to single-quoted form with
 3263: #             escaped apostrophes if no delimiter is
 3264: #             available.
 3265: #
 3266: # Entry:      $s - the string to wrap. May be undef.
 3267: # Exit:       Returns a Perl source-code fragment that
 3268: #             evaluates to the original string value,
 3269: #             or the string 'undef' if $s is undef.
 3270: #
 3271: # Notes:      index() returns -1 when not found and
 3272: #             any value >= 0 when found, including 0
 3273: #             for a delimiter at the start of the
 3274: #             string. We compare against $INDEX_NOT_FOUND
 3275: #             to make this boundary explicit and to
 3276: #             prevent off-by-one mutation survivors.
 3277: #             See GitHub issue #1.
 3278: # --------------------------------------------------
 3279: sub q_wrap {
●3280 → 3294 → 3303 3280: 	my $s = $_[0];
 3281: 
 3282: 	croak('q_wrap: argument must be a plain string, not a reference') if ref($s);
 3283: 
 3284: 	# Return empty string for undef — this function is a low-level
 3285: 	# string quoter only. Callers that need the Perl literal 'undef'
 3286: 	# for undefined values should use perl_quote() instead, which
 3287: 	# handles the undef -> 'undef' semantic conversion correctly.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3288: 	# Returning '' here preserves the original behaviour and avoids
 3289: 	# injecting the bare word 'undef' into contexts that expect a
 3290: 	# quoted string value.
 3291: 	return "''" unless defined $s;
 3292: 
 3293: 	# Try bracket-form q{} delimiters first — most readable
 3294: 	for my $p (@Q_BRACKET_PAIRS) {
 3295: 		my ($l, $r) = @{$p};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3296: 
 3297: 		# Only use this bracket pair if neither bracket
 3298: 		# appears in the string — both must be checked
 3299: 		return "q$l$s$r" unless $s =~ /\Q$l\E|\Q$r\E/;
 3300: 	}
 3301: 
 3302: 	# Try single-character delimiters in preference order
●3303 → 3303 → 3308 3303: 	for my $d (@Q_SINGLE_DELIMITERS) {
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3304: 		# index() returns $INDEX_NOT_FOUND (-1) when not found.
 3305: 		# Must use != $INDEX_NOT_FOUND rather than > 0 since
 3306: 		# the delimiter may legitimately appear at position 0
 3307: 		return "q$d$s$d" if index($s, $d) == $INDEX_NOT_FOUND;
 3308: 	}

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_3308_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_3308_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 3309: 
 3310: 	# Last resort — single-quoted string with escaped apostrophes
 3311: 	(my $esc = $s) =~ s/'/\\'/g;
 3312: 	return "'$esc'";
 3313: }
 3314: 
 3315: # --------------------------------------------------
 3316: # perl_sq
 3317: #
 3318: # Purpose:    Escape a string for safe inclusion
 3319: #             inside a single-quoted Perl string
 3320: #             literal in generated test code.
 3321: #
 3322: # Entry:      $s - the string to escape.
 3323: # Exit:       Returns the escaped string, or an
 3324: #             empty string if $s is undef.
 3325: #
 3326: # Notes:      NUL byte replacement produces the
 3327: #             two-character sequence \0 which is
 3328: #             only correct when the result is used
 3329: #             inside a double-quoted string context
 3330: #             in the generated test.
 3331: #
 3332: #             The \b substitution (backspace) is
 3333: #             intentionally omitted — in Perl regex
 3334: #             context \b means word boundary, not
 3335: #             backspace, so substituting it here
 3336: #             would corrupt strings containing word
 3337: #             boundaries.
 3338: # --------------------------------------------------
 3339: sub perl_sq {
 3340: 	my $s = $_[0];
 3341: 
 3342: 	croak('perl_sq: argument must be a plain string, not a reference') if ref($s);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3343: 
 3344: 	# Return empty string for undef — callers that need
 3345: 	# 'undef' literal should use perl_quote instead
 3346: 	return '' unless defined $s;
 3347: 
 3348: 	# Escape backslashes first so later substitutions
 3349: 	# don't double-escape already-escaped sequences
 3350: 	$s =~ s/\\/\\\\/g;
 3351: 
 3352: 	# Escape apostrophes so they don't terminate the
 3353: 	# surrounding single-quoted string literal
 3354: 	$s =~ s/'/\\'/g;
 3355: 
 3356: 	# Escape common control characters to their
 3357: 	# printable two-character escape sequences
 3358: 	$s =~ s/\n/\\n/g;
 3359: 	$s =~ s/\r/\\r/g;
 3360: 	$s =~ s/\t/\\t/g;
 3361: 	$s =~ s/\f/\\f/g;
 3362: 
 3363: 	# Replace NUL bytes with \0 — valid only in
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3364: 	# double-quoted string context in generated code
 3365: 	$s =~ s/\0/\\0/g;
 3366: 
 3367: 	return $s;
 3368: }
 3369: 
 3370: =head2 perl_quote
 3371: 
 3372: Convert any Perl value into a source-code fragment that reproduces that value
 3373: when evaluated in a generated test file.
 3374: 
 3375: =head3 Arguments
 3376: 
 3377: =over 4
 3378: 
 3379: =item * C<$v>
 3380: 
 3381: Any Perl value. May be undef, a scalar, an arrayref, a Regexp, or a blessed
 3382: object. All types are handled — undef becomes C<'undef'>, the strings
 3383: C<'true'>/C<'false'> become the Perl boolean constants C<!!1>/C<!!0>,
 3384: numbers are unquoted, other strings are single-quoted, arrayrefs recurse,
 3385: Regexps become C<qr{...}>, and anything else (including hashrefs and
 3386: blessed objects) falls through to C<render_fallback>.
 3387: 
 3388: =back
 3389: 
 3390: =head3 API specification
 3391: 
 3392: =head4 input
 3393: 
 3394:     { v => { type => 'any', optional => 1 } }
 3395: 
 3396: =head4 output
 3397: 
 3398:     { type => 'string' }
 3399: 
 3400: =cut
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3401: 
 3402: sub perl_quote {
 3403: 	my ($v) = @_;
 3404: 	return _perl_quote($v, 0);
 3405: }
 3406: 
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3407: sub _perl_quote {
●3408 → 3420 → 3444 3408: 	my ($v, $depth) = @_;
 3409: 	no warnings 'recursion';    ## no critic (TestingAndDebugging::ProhibitNoWarnings)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3410: 	croak('perl_quote: structure too deeply nested (circular reference?)') if $depth > 100;
 3411: 
 3412: 	# Undef produces the Perl literal 'undef'
 3413: 	return 'undef' unless defined $v;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3414: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3415: 	# Convert YAML boolean string literals to Perl
 3416: 	# boolean constants so they survive round-tripping
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3417: 	return '!!1' if $v eq 'true';
 3418: 	return '!!0' if $v eq 'false';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3419: 
 3420: 	if(ref($v)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3421: 		# Recursively quote each element of an arrayref
 3422: 		if(ref($v) eq 'ARRAY') {
 3423: 			my @quoted_v = map { _perl_quote($_, $depth + 1) } @{$v};
 3424: 			return '[ ' . join(', ', @quoted_v) . ' ]';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3425: 		}
 3426: 
 3427: 		# Render Regexp objects as qr{} with modifiers
 3428: 		if(ref($v) eq 'Regexp') {
 3429: 			my ($pat, $mods) = regexp_pattern($v);
 3430: 			my $re = "qr{$pat}";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3431: 
 3432: 			# Append modifiers (e.g. 'i', 'x') if present
 3433: 			$re .= $mods if $mods;
 3434: 			return $re;
 3435: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3436: 
 3437: 		# Hashrefs and other reference types fall through
 3438: 		# to render_fallback which uses Data::Dumper
 3439: 		return render_fallback($v);
 3440: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3441: 
 3442: 	# Numeric values are emitted unquoted so the generated
 3443: 	# test performs numeric rather than string comparison
 3444: 	return looks_like_number($v) ? $v : "'" . perl_sq($v) . "'";
 3445: }
 3446: 
 3447: # --------------------------------------------------
 3448: # _generate_transform_properties
 3449: #
 3450: # Convert a hashref of transform
 3451: #     specifications into an arrayref of
 3452: #     LectroTest property definition hashrefs,
 3453: #     one per transform. Each hashref contains
 3454: #     all the information needed by
 3455: #     _render_properties to emit a runnable
 3456: #     Test::LectroTest property block.
 3457: #
 3458: # Entry:      $transforms  - hashref of transform name
 3459: #                            => transform spec, as
 3460: #                            loaded from the schema.
 3461: #             $function    - name of the function under
 3462: #                            test.
 3463: #             $module      - module name, or undef for
 3464: #                            builtin functions.
 3465: #             $input       - the top-level input spec
 3466: #                            hashref from the schema
 3467: #                            (used for position sorting).
 3468: #             $config      - the normalised config
 3469: #                            hashref, used to read
 3470: #                            properties.trials.
 3471: #             $new         - defined if the function is
 3472: #                            an object method; the value
 3473: #                            is not used here since
 3474: #                            property tests always
 3475: #                            construct a fresh object
 3476: #                            via new_ok() with no args.
 3477: #                            Presence vs absence is the
 3478: #                            only signal used.
 3479: #
 3480: # Exit:       Returns an arrayref of property hashrefs.
 3481: #             Returns an empty arrayref if no transforms
 3482: #             produce any testable properties.
 3483: #             Never returns undef.
 3484: #
 3485: # Notes:      Transforms whose input is the string
 3486: #             'undef' or whose input spec is not a
 3487: #             hashref are silently skipped — they
 3488: #             represent error-case transforms that have
 3489: #             no meaningful generator.
 3490: #
 3491: #             The 'WARN' vs 'WARNS' distinction in
 3492: #             _STATUS: the schema convention uses
 3493: #             'WARNS' throughout. This function checks
 3494: #             for 'WARNS' to match that convention.
 3495: # --------------------------------------------------
 3496: sub _generate_transform_properties {
●3497 → 3501 → 3645 3497: 	my ($transforms, $function, $module, $input, $config, $new) = @_;
 3498: 
 3499: 	my @properties;
 3500: 
 3501: 	for my $transform_name (sort keys %{$transforms}) {
 3502: 		# $transform_name is spliced by _render_properties as a Perl
 3503: 		# *variable name* (my $$transform_name = Property {...}), not
 3504: 		# just inside a string literal — reject anything that isn't
 3505: 		# identifier-shaped before it reaches that point.
 3506: 		_assert_identifier($transform_name, 'transform name');
 3507: 
 3508: 		my $transform   = $transforms->{$transform_name};
 3509: 
 3510: 		my $input_spec  = $transform->{input};
 3511: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3512: 		# Guard: skip transforms with no input or with the
 3513: 		# YAML scalar 'undef' as their input — these have no
 3514: 		# generator and cannot produce meaningful properties
 3515: 		if(!defined($input_spec) ||
 3516: 		   (!ref($input_spec) && $input_spec eq 'undef')) {
 3517: 			next;
 3518: 		}
 3519: 
 3520: 		# Guard: skip transforms whose input is not a hashref —
 3521: 		# must come before the helper calls below so we never
 3522: 		# pass a non-hash to _detect_transform_properties or
 3523: 		# _process_custom_properties
 3524: 		next unless ref($input_spec) eq 'HASH';
 3525: 
 3526: 		# Default output spec to empty hash so _STATUS lookups
 3527: 		# below are always safe regardless of schema content
 3528: 		my $output_spec = $transform->{output} // {};
 3529: 
 3530: 		# Detect automatic properties from the transform spec
 3531: 		# (range constraints, type preservation, definedness)
 3532: 		my @detected_props = _detect_transform_properties(
 3533: 			$transform_name,
 3534: 			$input_spec,
 3535: 			$output_spec
 3536: 		);

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_3536_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3537: 
 3538: 		# Process any custom properties defined in the schema
 3539: 		my @custom_props = ();
 3540: 		if(exists($transform->{properties}) &&
 3541: 		   ref($transform->{properties}) eq 'ARRAY') {
 3542: 			@custom_props = _process_custom_properties(
 3543: 				$transform->{properties},
 3544: 				$function,
 3545: 				$module,
 3546: 				$input_spec,
 3547: 				$output_spec,
 3548: 				$new
 3549: 			);
 3550: 		}
 3551: 
 3552: 		# Combine auto-detected and custom properties into one list
 3553: 		my @all_props = (@detected_props, @custom_props);
 3554: 
 3555: 		# Skip this transform if no properties were produced —
 3556: 		# nothing useful to render into the generated test
 3557: 		next unless @all_props;
 3558: 
 3559: 		# Build the LectroTest generator specification string,
 3560: 		# one entry per input field that has a generator
 3561: 		my @generators;
 3562: 		my @var_names;
 3563: 
 3564: 		for my $field (sort keys %{$input_spec}) {
 3565: 			my $spec = $input_spec->{$field};
 3566: 
 3567: 			# Skip non-hashref field specs — scalar types
 3568: 			# like 'string' have no generator sub-structure
 3569: 			next unless ref($spec) eq 'HASH';
 3570: 
 3571: 			# $field is spliced unescaped into the generated
 3572: 			# LectroTest generator spec by
 3573: 			# _schema_to_lectrotest_generator() — reject anything
 3574: 			# that isn't identifier-shaped first.

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_3574_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3575: 			_assert_identifier($field, 'input field name');
 3576: 
 3577: 			my $gen = _schema_to_lectrotest_generator($field, $spec);
 3578: 			if(defined($gen) && length($gen)) {
 3579: 				push @generators, $gen;
 3580: 				push @var_names, $field;
 3581: 			}
 3582: 		}
 3583: 
 3584: 		my $gen_spec = join(', ', @generators);
 3585: 
 3586: 		# Build the call expression for the function under test.
 3587: 		# Note: property tests always construct a fresh object
 3588: 		# via new_ok() with no constructor arguments, regardless
 3589: 		# of what $new holds in the caller — the intent here is
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3590: 		# to test the method in isolation, not with specific
 3591: 		# construction state.
 3592: 		my $call_code;
 3593: 		if($module && defined($new)) {
 3594: 			# OO mode — construct a fresh object for each trial
 3595: 			$call_code  = "my \$obj = new_ok('$module');";
 3596: 			$call_code .= "\$obj->$function";
 3597: 		} elsif($module && $module ne $MODULE_BUILTIN) {
 3598: 			# Functional mode with a named module
 3599: 			$call_code = "$module\::$function";
 3600: 		} else {
 3601: 			# Builtin or unqualified function call
 3602: 			$call_code = $function;
 3603: 		}
 3604: 

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_3604_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3605: 		# Build the argument list, respecting positional order
 3606: 		# if the input spec declares positions
 3607: 		my @args;
 3608: 		if(_has_positions($input_spec)) {
 3609: 			# Sort fields by declared position so the generated
 3610: 			# call passes arguments in the correct order
 3611: 			my @sorted = sort {
 3612: 				$input_spec->{$a}{position} <=>
 3613: 				$input_spec->{$b}{position}
 3614: 			} keys %{$input_spec};
 3615: 			@args = map { "\$$_" } @sorted;
 3616: 		} else {
 3617: 			# No positions — use alphabetical order from @var_names
 3618: 			@args = map { "\$$_" } @var_names;
 3619: 		}
 3620: 
 3621: 		my $args_str = join(', ', @args);
 3622: 
 3623: 		# Concatenate all property check expressions with &&
 3624: 		# so the generated property block passes only when
 3625: 		# every check holds
 3626: 		my @checks = map { $_->{code} } @all_props;
 3627: 		my $property_checks = join(" &&\n\t", @checks);
 3628: 
 3629: 		# Determine expected behaviour from output _STATUS.
 3630: 		# Note: the schema convention uses 'WARNS' not 'WARN'
 3631: 		my $should_die  = ($output_spec->{'_STATUS'} // '') eq 'DIES';
 3632: 		my $should_warn = ($output_spec->{'_STATUS'} // '') eq 'WARNS';
 3633: 
 3634: 		push @properties, {
 3635: 			name             => $transform_name,
 3636: 			generator_spec   => $gen_spec,
 3637: 			call_code        => "$call_code($args_str)",
 3638: 			property_checks  => $property_checks,
 3639: 			should_die       => $should_die,
 3640: 			should_warn      => $should_warn,
 3641: 			trials           => $config->{'properties'}{'trials'} // $DEFAULT_PROPERTY_TRIALS,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3642: 		};
 3643: 	}
 3644: 
 3645: 	return \@properties;
 3646: }
 3647: 
 3648: # --------------------------------------------------
 3649: # _get_semantic_generators
 3650: #
 3651: # Return a hashref of named semantic
 3652: #     generator definitions for use in
 3653: #     LectroTest property-based tests.
 3654: #     Each entry contains a 'code' key
 3655: #     holding a Gen {} block string and a
 3656: #     'description' key for documentation
 3657: #     and validation messages.
 3658: #
 3659: # Entry:      None.
 3660: #
 3661: # Exit:       Returns a hashref keyed by semantic
 3662: #             type name. Each value is a hashref
 3663: #             with 'code' and 'description' keys.
 3664: #
 3665: # Notes:      The returned hashref is built fresh
 3666: #             on every call — callers that need it
 3667: #             repeatedly should cache the result.
 3668: #             The 'code' strings are multi-line
 3669: #             Gen {} blocks; callers are responsible
 3670: #             for compressing whitespace before
 3671: #             embedding them in generated test files.
 3672: # --------------------------------------------------
 3673: sub _get_semantic_generators {
 3674: 	return {
 3675: 		email => {
 3676: 			code => q{
 3677: 				Gen {
 3678: 					my $len = 5 + int(rand(10));
 3679: 					my @addr;
 3680: 					my @tlds = qw(com org net edu gov io co uk de fr);
 3681: 
 3682: 					for(my $i = 0; $i < $len; $i++) {
 3683: 						push @addr, pack('c', (int(rand 26))+97);
 3684: 					}
 3685: 					push @addr, '@';
 3686: 					$len = 5 + int(rand(10));
 3687: 					for(my $i = 0; $i < $len; $i++) {
 3688: 						push @addr, pack('c', (int(rand 26))+97);
 3689: 					}
 3690: 					push @addr, '.';
 3691: 					$len = rand($#tlds+1);
 3692: 					push @addr, $tlds[$len];
 3693: 					return join('', @addr);
 3694: 				}
 3695: 			},
 3696: 			description => 'Valid email addresses',
 3697: 		}, url => {
 3698: 			code => q{
 3699: 				Gen {
 3700: 					my @schemes = qw(http https);
 3701: 					my @tlds = qw(com org net io);
 3702: 					my $scheme = $schemes[int(rand(@schemes))];
 3703: 					my $domain = join('', map { ('a'..'z')[int(rand(26))] } 1..(5 + int(rand(10))));
 3704: 					my $tld = $tlds[int(rand(@tlds))];
 3705: 					my $path = join('', map { ('a'..'z', '0'..'9', '-', '_')[int(rand(38))] } 1..int(rand(20)));
 3706: 
 3707: 					return "$scheme://$domain.$tld" . ($path ? "/$path" : '');
 3708: 				}
 3709: 			},
 3710: 			description => 'Valid HTTP/HTTPS URLs',
 3711: 		}, uuid => {
 3712: 			code => q{
 3713: 				Gen {
 3714: 					require UUID::Tiny;
 3715: 					UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_V4());
 3716: 				}
 3717: 			},
 3718: 			description => 'Valid UUIDv4 identifiers',
 3719: 		}, phone_us => {
 3720: 			code => q{
 3721: 				Gen {
 3722: 					my $area = 200 + int(rand(800));
 3723: 					my $exchange = 200 + int(rand(800));
 3724: 					my $subscriber = int(rand(10000));
 3725: 					sprintf('%03d-%03d-%04d', $area, $exchange, $subscriber);
 3726: 				}
 3727: 			},
 3728: 			description => 'US phone numbers (XXX-XXX-XXXX format)',
 3729: 		}, phone_e164 => {
 3730: 			code => q{
 3731: 				Gen {
 3732: 					my $country = 1 + int(rand(999));
 3733: 					my $area = 100 + int(rand(900));
 3734: 					my $number = int(rand(10000000));
 3735: 					sprintf('+%d%03d%07d', $country, $area, $number);
 3736: 				}
 3737: 			},
 3738: 			description => 'E.164 international phone numbers',
 3739: 		}, ipv4 => {
 3740: 			code => q{
 3741: 				Gen {
 3742: 					join('.', map { int(rand(256)) } 1..4);
 3743: 				}
 3744: 			},
 3745: 			description => 'IPv4 addresses',
 3746: 		}, ipv6 => {
 3747: 			code => q{
 3748: 				Gen {
 3749: 					join(':', map { sprintf('%04x', int(rand(0x10000))) } 1..8);
 3750: 				}
 3751: 			},
 3752: 			description => 'IPv6 addresses',
 3753: 		}, username => {
 3754: 			code => q{
 3755: 				Gen {
 3756: 					my $len = 3 + int(rand(13));
 3757: 					my @chars = ('a'..'z', '0'..'9', '_', '-');
 3758: 					my $first = ('a'..'z')[int(rand(26))];
 3759: 					$first . join('', map { $chars[int(rand(@chars))] } 1..($len-1));
 3760: 				}
 3761: 			},
 3762: 			description => 'Valid usernames (alphanumeric with _ and -)',
 3763: 		}, slug => {
 3764: 			code => q{
 3765: 				Gen {
 3766: 					my @words = qw(quick brown fox jumps over lazy dog hello world test data);
 3767: 					my $count = 1 + int(rand(4));
 3768: 					join('-', map { $words[int(rand(@words))] } 1..$count);
 3769: 				}
 3770: 			},
 3771: 			description => 'URL slugs (lowercase words separated by hyphens)',
 3772: 		}, hex_color => {
 3773: 			code => q{
 3774: 				Gen {
 3775: 					sprintf('#%06x', int(rand(0x1000000)));
 3776: 				}
 3777: 			},
 3778: 			description => 'Hex color codes (#RRGGBB)',
 3779: 		}, iso_date => {
 3780: 			code => q{
 3781: 				Gen {
 3782: 					my $year = 2000 + int(rand(25));
 3783: 					my $month = 1 + int(rand(12));
 3784: 					my $day = 1 + int(rand(28));
 3785: 					sprintf('%04d-%02d-%02d', $year, $month, $day);
 3786: 				}
 3787: 			},
 3788: 			description => 'ISO 8601 date format (YYYY-MM-DD)',
 3789: 		},
 3790: 		iso_datetime => {
 3791: 			code => q{
 3792: 				Gen {
 3793: 					my $year = 2000 + int(rand(25));
 3794: 					my $month = 1 + int(rand(12));
 3795: 					my $day = 1 + int(rand(28));
 3796: 					my $hour = int(rand(24));
 3797: 					my $minute = int(rand(60));
 3798: 					my $second = int(rand(60));
 3799: 					sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ',
 3800: 						$year, $month, $day, $hour, $minute, $second);
 3801: 				}
 3802: 			},
 3803: 			description => 'ISO 8601 datetime format (YYYY-MM-DDTHH:MM:SSZ)',
 3804: 		}, semver => {
 3805: 			code => q{
 3806: 				Gen {
 3807: 					my $major = int(rand(10));
 3808: 					my $minor = int(rand(20));
 3809: 					my $patch = int(rand(50));
 3810: 					"$major.$minor.$patch";
 3811: 				}
 3812: 			},
 3813: 			description => 'Semantic version strings (major.minor.patch)',
 3814: 		}, jwt => {
 3815: 			code => q{
 3816: 				Gen {
 3817: 					my @chars = ('A'..'Z', 'a'..'z', '0'..'9', '-', '_');
 3818: 					my $header    = join('', map { $chars[int(rand(@chars))] } 1..20);
 3819: 					my $payload   = join('', map { $chars[int(rand(@chars))] } 1..40);
 3820: 					my $signature = join('', map { $chars[int(rand(@chars))] } 1..30);
 3821: 					"$header.$payload.$signature";
 3822: 				}
 3823: 			},
 3824: 			description => 'JWT-like tokens (base64url format)',
 3825: 		}, json => {
 3826: 			code => q{
 3827: 				Gen {
 3828: 					my @keys = qw(id name value status count);
 3829: 					my $key = $keys[int(rand(@keys))];
 3830: 					my $value = 1 + int(rand(1000));
 3831: 					qq({"$key":$value});
 3832: 				}
 3833: 			},
 3834: 			description => 'Simple JSON objects',
 3835: 		}, base64 => {
 3836: 			code => q{
 3837: 				Gen {
 3838: 					my @chars = ('A'..'Z', 'a'..'z', '0'..'9', '+', '/');
 3839: 					my $len = 12 + int(rand(20));
 3840: 					my $str = join('', map { $chars[int(rand(@chars))] } 1..$len);
 3841: 					$str .= '=' x (4 - ($len % 4)) if $len % 4;
 3842: 					$str;
 3843: 				}
 3844: 			},
 3845: 			description => 'Base64-encoded strings',
 3846: 		}, md5 => {
 3847: 			code => q{
 3848: 				Gen {
 3849: 					join('', map { sprintf('%x', int(rand(16))) } 1..32);
 3850: 				}
 3851: 			},
 3852: 			description => 'MD5 hashes (32 hex characters)',
 3853: 		}, sha256 => {
 3854: 			code => q{
 3855: 				Gen {
 3856: 					join('', map { sprintf('%x', int(rand(16))) } 1..64);
 3857: 				}
 3858: 			},
 3859: 			description => 'SHA-256 hashes (64 hex characters)',
 3860: 		}, unix_timestamp => {
 3861: 			code => q{
 3862: 				Gen {
 3863: 					time;
 3864: 				}
 3865: 			},
 3866: 			description => 'Unix timestamps (seconds since epoch)',
 3867: 		},
 3868: 	};
 3869: }
 3870: 
 3871: # --------------------------------------------------
 3872: # _get_builtin_properties
 3873: #
 3874: # Purpose:    Return a hashref of named built-in
 3875: #             property templates that can be
 3876: #             referenced by name in a transform's
 3877: #             'properties' list in the schema.
 3878: #             Each entry contains a 'description'
 3879: #             string, a 'code_template' coderef, and
 3880: #             an 'applicable_to' arrayref.
 3881: #
 3882: # Entry:      None.
 3883: #
 3884: # Exit:       Returns a hashref keyed by property
 3885: #             name. Each value is a hashref with
 3886: #             'description', 'code_template', and
 3887: #             'applicable_to' keys.
 3888: #
 3889: # Notes:      'applicable_to' lists the types for
 3890: #             which each property is meaningful. It
 3891: #             is stored for documentation purposes
 3892: #             and potential future filtering — it is
 3893: #             not currently enforced by any caller.
 3894: #
 3895: #             Each 'code_template' coderef receives
 3896: #             three arguments: ($function, $call_code,
 3897: #             $input_vars). Most templates use only
 3898: #             $call_code; $function and $input_vars
 3899: #             are provided for templates that need
 3900: #             them (e.g. idempotent, length_preserved,
 3901: #             preserves_keys).
 3902: #
 3903: #             'monotonic_increasing' has been
 3904: #             intentionally omitted. A correct
 3905: #             implementation requires calling the
 3906: #             function twice with ordered inputs,
 3907: #             which the current single-call property
 3908: #             framework does not support. A
 3909: #             placeholder that unconditionally returns
 3910: #             true would give false confidence and has
 3911: #             therefore been removed.
 3912: # --------------------------------------------------
 3913: sub _get_builtin_properties {
 3914: 	return {
 3915: 		idempotent => {
 3916: 			description   => 'Function is idempotent: f(f(x)) == f(x)',
 3917: 			code_template => sub {
 3918: 				my ($function, $call_code, $input_vars) = @_;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3919: 
 3920: 				# String comparison works for all scalar types in Perl —
 3921: 				# numeric values stringify consistently for eq
 3922: 				return "do { my \$tmp = $call_code; \$result eq \$tmp }";
 3923: 			},
 3924: 			applicable_to => ['all'],
 3925: 		}, non_negative => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3926: 			description   => 'Result is always non-negative',
 3927: 			code_template => sub {
 3928: 				my ($function, $call_code, $input_vars) = @_;
 3929: 				return '$result >= 0';
 3930: 			},
 3931: 			applicable_to => ['number', 'integer', 'float'],
 3932: 		}, positive => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3933: 			description   => 'Result is always positive (> 0)',
 3934: 			code_template => sub {
 3935: 				my ($function, $call_code, $input_vars) = @_;
 3936: 				return '$result > 0';
 3937: 			},
 3938: 			applicable_to => ['number', 'integer', 'float'],
 3939: 		}, non_empty => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3940: 			description   => 'Result is never empty',
 3941: 			code_template => sub {
 3942: 				my ($function, $call_code, $input_vars) = @_;
 3943: 				return 'length($result) > 0';
 3944: 			},
 3945: 			applicable_to => ['string'],
 3946: 		},
 3947: 
 3948: 		length_preserved => {
 3949: 			description   => 'Output length equals input length',
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3950: 			code_template => sub {
 3951: 				my ($function, $call_code, $input_vars) = @_;
 3952: 				my $first_var = $input_vars->[0];
 3953: 				return "length(\$result) == length(\$$first_var)";
 3954: 			},
 3955: 			applicable_to => ['string'],
 3956: 		},
 3957: 
 3958: 		uppercase => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3959: 			description   => 'Result is all uppercase',
 3960: 			code_template => sub {
 3961: 				my ($function, $call_code, $input_vars) = @_;
 3962: 				return '$result eq uc($result)';
 3963: 			},
 3964: 			applicable_to => ['string'],
 3965: 		},
 3966: 
 3967: 		lowercase => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3968: 			description   => 'Result is all lowercase',
 3969: 			code_template => sub {
 3970: 				my ($function, $call_code, $input_vars) = @_;
 3971: 				return '$result eq lc($result)';
 3972: 			},
 3973: 			applicable_to => ['string'],
 3974: 		},
 3975: 
 3976: 		trimmed => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3977: 			description   => 'Result has no leading or trailing whitespace',
 3978: 			code_template => sub {
 3979: 				my ($function, $call_code, $input_vars) = @_;
 3980: 				return '$result !~ /^\s/ && $result !~ /\s$/';
 3981: 			},
 3982: 			applicable_to => ['string'],
 3983: 		},
 3984: 
 3985: 		sorted_ascending => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3986: 			description   => 'Array is sorted in ascending order',
 3987: 			code_template => sub {
 3988: 				my ($function, $call_code, $input_vars) = @_;
 3989: 				return 'do { my @arr = @$result; my $sorted = 1; ' .
 3990: 					'for my $i (1..$#arr) { $sorted = 0 if $arr[$i] < $arr[$i-1]; } ' .
 3991: 					'$sorted }';
 3992: 			},
 3993: 			applicable_to => ['arrayref'],
 3994: 		},
 3995: 
 3996: 		sorted_descending => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3997: 			description   => 'Array is sorted in descending order',
 3998: 			code_template => sub {
 3999: 				my ($function, $call_code, $input_vars) = @_;
 4000: 				return 'do { my @arr = @$result; my $sorted = 1; ' .
 4001: 					'for my $i (1..$#arr) { $sorted = 0 if $arr[$i] > $arr[$i-1]; } ' .
 4002: 					'$sorted }';
 4003: 			},
 4004: 			applicable_to => ['arrayref'],
 4005: 		},
 4006: 
 4007: 		unique_elements => {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4008: 			description   => 'Array has no duplicate elements',
 4009: 			code_template => sub {
 4010: 				my ($function, $call_code, $input_vars) = @_;
 4011: 				return 'do { my @arr = @$result; my %seen; !grep { $seen{$_}++ } @arr }';
 4012: 			},
 4013: 			applicable_to => ['arrayref'],
 4014: 		},
 4015: 
 4016: 		preserves_keys => {
 4017: 			description   => 'Hash has same keys as input',
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4018: 			code_template => sub {
 4019: 				my ($function, $call_code, $input_vars) = @_;
 4020: 				my $first_var = $input_vars->[0];
 4021: 				return 'do { my @in  = sort keys %{$' . $first_var . '}; ' .
 4022: 					'my @out = sort keys %$result; ' .
 4023: 					'join(",", @in) eq join(",", @out) }';
 4024: 			},
 4025: 			applicable_to => ['hashref'],
 4026: 		},
 4027: 	};
 4028: }
 4029: 
 4030: # --------------------------------------------------
 4031: # _schema_to_lectrotest_generator
 4032: #
 4033: # Purpose:    Convert a single schema field spec
 4034: #             hashref into a LectroTest generator
 4035: #             declaration string of the form
 4036: #             '$field <- Generator(...)'.
 4037: #             Used to build the ##[ ... ]## generator
 4038: #             block inside a Property definition.
 4039: #
 4040: # Entry:      $field_name - the parameter name as it
 4041: #                           will appear in the
 4042: #                           generated test code.
 4043: #             $spec       - hashref containing at
 4044: #                           minimum a 'type' key.
 4045: #                           May also contain 'min',
 4046: #                           'max', 'semantic', and
 4047: #                           'matches' keys depending
 4048: #                           on type.
 4049: #
 4050: # Exit:       Returns a string of the form
 4051: #             '$field <- Generator(...)' on success.
 4052: #             Returns undef if the spec is not a
 4053: #             hashref or if range constraints are
 4054: #             invalid (min >= max for numeric types).
 4055: #             Returns a String generator with a carp
 4056: #             warning for unknown types.
 4057: #
 4058: # Side effects: Carps on unknown semantic types,
 4059: #               invalid numeric ranges, and unknown
 4060: #               field types.
 4061: #
 4062: # Notes:      Semantic generators are checked first
 4063: #             for string fields and take precedence
 4064: #             over the regular string generator.
 4065: #             The $input_spec parameter in the type-
 4066: #             detection helpers is reserved for future
 4067: #             use and is currently unused.
 4068: # --------------------------------------------------
 4069: sub _schema_to_lectrotest_generator {
●4070 → 4083 → 4107 4070: 	my ($field_name, $spec) = @_;
 4071: 
 4072: 	# Guard: must be a hashref to dereference safely
 4073: 	return unless defined($spec) && ref($spec) eq 'HASH';
 4074: 
 4075: 	# Default to string when no type is declared
 4076: 	my $type = $spec->{'type'} || $DEFAULT_FIELD_TYPE;
 4077: 
 4078: 	# --------------------------------------------------
 4079: 	# Semantic generators take precedence for string
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4080: 	# fields — they produce realistic domain-specific
 4081: 	# values rather than random character sequences
 4082: 	# --------------------------------------------------
 4083: 	if($type eq 'string' && defined($spec->{'semantic'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4084: 		my $semantic_type = $spec->{'semantic'};
 4085: 		my $generators    = _get_semantic_generators();
 4086: 
 4087: 		if(exists($generators->{$semantic_type})) {
 4088: 			my $gen_code = $generators->{$semantic_type}{'code'};
 4089: 
 4090: 			# Compress the multi-line generator code into a
 4091: 			# single line for embedding in the ##[ ]## block
 4092: 			$gen_code =~ s/^\s+//;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4093: 			$gen_code =~ s/\s+$//;
 4094: 			$gen_code =~ s/\n\s+/ /g;
 4095: 
 4096: 			return "$field_name <- $gen_code";
 4097: 		} else {
 4098: 			carp "Unknown semantic type '$semantic_type', " .
 4099: 				"falling back to regular string generator";
 4100: 			# Fall through to regular string generation below
 4101: 		}
 4102: 	}
 4103: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4104: 	# --------------------------------------------------
 4105: 	# Integer generator
 4106: 	# --------------------------------------------------
●4107 → 4107 → 4130 4107: 	if($type eq 'integer') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4108: 		my $min = $spec->{'min'};
 4109: 		my $max = $spec->{'max'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4110: 
 4111: 		if(!defined($min) && !defined($max)) {
 4112: 			# Unconstrained — use LectroTest's built-in Int

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4112_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4112_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4113: 			return "$field_name <- Int";
 4114: 		} elsif(!defined($min)) {
 4115: 			# Only max defined — generate 0 to max

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4115_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4115_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4116: 			return "$field_name <- Int(sized => sub { int(rand($max + 1)) })";
 4117: 		} elsif(!defined($max)) {
 4118: 			# Only min defined — generate min to min + range
 4119: 			return "$field_name <- Int(sized => sub { $min + int(rand($DEFAULT_GENERATOR_RANGE)) })";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4120: 		} else {
 4121: 			# Both defined — generate within [min, max]
 4122: 			my $range = $max - $min;
 4123: 			return "$field_name <- Int(sized => sub { $min + int(rand($range + 1)) })";
 4124: 		}
 4125: 	}
 4126: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4127: 	# --------------------------------------------------
 4128: 	# Float / number generator
 4129: 	# --------------------------------------------------
●4130 → 4130 → 4180 4130: 	if($type eq 'number' || $type eq 'float') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4131: 		my $min = $spec->{'min'};
 4132: 		my $max = $spec->{'max'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4133: 
 4134: 		if(!defined($min) && !defined($max)) {
 4135: 			# Unconstrained — symmetric range around zero
 4136: 			return "$field_name <- Float(sized => sub { rand($DEFAULT_GENERATOR_RANGE) - $DEFAULT_GENERATOR_RANGE / 2 })";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4137: 
 4138: 		} elsif(!defined($min)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4139: 			# Only max defined — choose range based on sign of max
  Mutants (Total: 3, Killed: 3, Survived: 0)
 4140: 			if($max == $ZERO_BOUNDARY) {
 4141: 				# max=0: negative numbers only
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4142: 				return "$field_name <- Float(sized => sub { -rand($DEFAULT_GENERATOR_RANGE) })";
 4143: 			} elsif($max > $ZERO_BOUNDARY) {
 4144: 				# Positive max: generate 0 to max
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4145: 				return "$field_name <- Float(sized => sub { rand($max) })";
 4146: 			} else {
 4147: 				# Negative max: generate from (max - range) to max
 4148: 				return "$field_name <- Float(sized => sub { ($max - $DEFAULT_GENERATOR_RANGE) + rand($DEFAULT_GENERATOR_RANGE + $max) })";
 4149: 			}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4150: 
 4151: 		} elsif(!defined($max)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4152: 			# Only min defined — choose range based on sign of min

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_4152_17_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4152_17_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4152_17_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 4153: 			if($min == $ZERO_BOUNDARY) {
 4154: 				# min=0: positive numbers only
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4155: 				return "$field_name <- Float(sized => sub { rand($DEFAULT_GENERATOR_RANGE) })";
 4156: 			} elsif($min > $ZERO_BOUNDARY) {
 4157: 				# Positive min: generate min to min + range
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4158: 				return "$field_name <- Float(sized => sub { $min + rand($DEFAULT_GENERATOR_RANGE) })";
 4159: 			} else {
 4160: 				# Negative min: generate from min to min + range
 4161: 				return "$field_name <- Float(sized => sub { $min + rand(-$min + $DEFAULT_GENERATOR_RANGE) })";
 4162: 			}
 4163: 
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4164: 		} else {
 4165: 			# Both min and max defined — validate then generate
 4166: 			my $range = $max - $min;
 4167: 			if($range <= $ZERO_BOUNDARY) {
 4168: 				carp "Invalid range for '$field_name': min=$min, max=$max";
 4169: 				# Return undef rather than emitting a degenerate
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4170: 				# generator that would silently produce wrong values
 4171: 				return;
 4172: 			}
 4173: 			return "$field_name <- Float(sized => sub { $min + rand($range) })";
 4174: 		}
 4175: 	}
 4176: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4177: 	# --------------------------------------------------
 4178: 	# String generator
 4179: 	# --------------------------------------------------
●4180 → 4180 → 4219 4180: 	if($type eq 'string') {
 4181: 		my $min_len = $spec->{'min'} // 0;
 4182: 		my $max_len = $spec->{'max'} // $DEFAULT_MAX_STRING_LEN;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4183: 
 4184: 		# If a regex pattern is declared, delegate to
 4185: 		# Data::Random::String::Matches for pattern-aware generation
 4186: 		if(defined($spec->{'matches'})) {
 4187: 			my $pattern = $spec->{'matches'};
 4188: 
 4189: 			# Compile the pattern safely rather than splicing the raw
 4190: 			# string into qr/$pattern/ — the raw form lets a pattern
 4191: 			# containing an unescaped '/' break out of the qr//
 4192: 			# delimiter and inject arbitrary Perl into the generated
 4193: 			# test. regexp_pattern() decomposes the already-compiled
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4194: 			# Regexp object back into pattern text that is guaranteed
 4195: 			# to be a self-contained regex body, safe to re-embed.

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4195_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4195_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4196: 			my $compiled = ref($pattern) eq 'Regexp' ? $pattern : eval { qr/$pattern/ };
 4197: 			if($@ || !defined($compiled)) {
 4198: 				carp "Invalid matches pattern '$pattern' for field '$field_name': $@";
 4199: 				return "$field_name <- String(length => [$min_len, $max_len])";
 4200: 			}

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4200_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4201: 			my ($pat, $mods) = regexp_pattern($compiled);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4201_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4201_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4202: 			my $safe_re = "qr{$pat}" . ($mods // '');
 4203: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4203_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4203_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4204: 			if(defined($spec->{'max'})) {
 4205: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => $safe_re, length => $spec->{'max'} }) }";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4206: 			} elsif(defined($spec->{'min'})) {
 4207: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => $safe_re, length => $spec->{'min'} }) }";
 4208: 			} else {
 4209: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => $safe_re }) }";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4210: 			}
 4211: 		}
 4212: 
 4213: 		return "$field_name <- String(length => [$min_len, $max_len])";
 4214: 	}
 4215: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4216: 	# --------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4217: 	# Boolean generator
 4218: 	# --------------------------------------------------
●4219 → 4219 → 4226 4219: 	if($type eq 'boolean') {
 4220: 		return "$field_name <- Bool";
 4221: 	}
 4222: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4223: 	# --------------------------------------------------
 4224: 	# Arrayref generator
 4225: 	# --------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
●4226 → 4226 → 4237 4226: 	if($type eq 'arrayref') {
 4227: 		my $min_size = $spec->{'min'} // 0;
 4228: 		my $max_size = $spec->{'max'} // $DEFAULT_MAX_COLLECTION_SIZE;
 4229: 		return "$field_name <- List(Int, length => [$min_size, $max_size])";
 4230: 	}
 4231: 
 4232: 	# --------------------------------------------------
 4233: 	# Hashref generator

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4233_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4234: 	# LectroTest has no built-in Hash generator so we
 4235: 	# use Elements over a pre-built list of hashrefs
 4236: 	# --------------------------------------------------

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4236_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4236_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
●4237 → 4237 → 4246 4237: 	if($type eq 'hashref') {
 4238: 		my $min_keys = $spec->{'min'} // 0;
 4239: 		my $max_keys = $spec->{'max'} // $DEFAULT_MAX_COLLECTION_SIZE;
 4240: 		return "$field_name <- Elements(map { my \%h; for (1..\$_) { \$h{'key'.\$_} = \$_ }; \\\%h } $min_keys..$max_keys)";
 4241: 	}
 4242: 
 4243: 	# --------------------------------------------------

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_4243_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_4243_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 4244: 	# Unknown type — fall back to String with a warning
 4245: 	# --------------------------------------------------
 4246: 	carp "Unknown type '$type' for '$field_name' LectroTest generator, using String";
 4247: 	return "$field_name <- String";
 4248: }
 4249: 
 4250: # --------------------------------------------------
 4251: # _is_numeric_transform
 4252: #
 4253: # Determine whether a transform's output
 4254: #     spec declares a numeric type, indicating
 4255: #     that numeric range properties should be
 4256: #     generated for it.
 4257: #
 4258: # Entry:      $input_spec  - the transform's input
 4259: #                            spec hashref. Currently
 4260: #                            unused; reserved for
 4261: #                            future input-type checks.
 4262: #             $output_spec - the transform's output
 4263: #                            spec hashref.
 4264: #
 4265: # Exit:       Returns 1 if the output type is one of
 4266: #             'number', 'integer', or 'float'.
 4267: #             Returns 0 otherwise.
 4268: # --------------------------------------------------
 4269: sub _is_numeric_transform {
 4270: 	my ($input_spec, $output_spec) = @_;
 4271: 
 4272: 	# $input_spec is currently unused — reserved for future
 4273: 	# input-side type checking when detecting mixed transforms
 4274: 	my $out_type = ($output_spec // {})->{'type'} // '';
 4275: 
 4276: 	return($out_type eq 'number' || $out_type eq 'integer' || $out_type eq 'float');
 4277: }
 4278: 
 4279: # --------------------------------------------------
 4280: # _is_string_transform
 4281: #
 4282: # Purpose:    Determine whether a transform's output
 4283: #             spec declares a string type, indicating
 4284: #             that string length and pattern properties
 4285: #             should be generated for it.
 4286: #
 4287: # Entry:      $input_spec  - the transform's input
 4288: #                            spec hashref. Currently
 4289: #                            unused; reserved for
 4290: #                            future input-type checks.
 4291: #             $output_spec - the transform's output
 4292: #                            spec hashref.
 4293: #
 4294: # Exit:       Returns 1 if the output type is 'string'.
 4295: #             Returns 0 otherwise.
 4296: # --------------------------------------------------
 4297: sub _is_string_transform {
 4298: 	my ($input_spec, $output_spec) = @_;
 4299: 
 4300: 	# $input_spec is currently unused — reserved for future
 4301: 	# input-side type checking when detecting mixed transforms
 4302: 	my $out_type = ($output_spec // {})->{'type'} // '';
 4303: 
 4304: 	return($out_type eq 'string');
 4305: }
 4306: 
 4307: # --------------------------------------------------
 4308: # _same_type
 4309: #
 4310: # Purpose:    Determine whether the dominant type of
 4311: #             a transform's input and output specs
 4312: #             match, indicating that type-preservation
 4313: #             properties are meaningful.
 4314: #
 4315: # Entry:      $input_spec  - the transform's input
 4316: #                            spec hashref, or a nested
 4317: #                            multi-field hashref.
 4318: #             $output_spec - the transform's output
 4319: #                            spec hashref.
 4320: #
 4321: # Exit:       Returns 1 if the dominant input and
 4322: #             output types are identical strings.
 4323: #             Returns 0 otherwise.
 4324: #
 4325: # Notes:      Uses _get_dominant_type for both sides.
 4326: #             For multi-field input specs, dominant
 4327: #             type is the type of the first field
 4328: #             encountered — this is a simplification.
 4329: #             TODO: extend to handle mixed-type inputs
 4330: #             by checking all fields, not just the
 4331: #             first one found.
 4332: # --------------------------------------------------
 4333: sub _same_type {
 4334: 	my ($input_spec, $output_spec) = @_;
 4335: 
 4336: 	# Guard: treat missing specs as untyped — two untyped
 4337: 	# specs both default to $DEFAULT_FIELD_TYPE and would
 4338: 	# compare equal, which is intentionally conservative
 4339: 	my $in_type  = _get_dominant_type($input_spec  // {});
 4340: 	my $out_type = _get_dominant_type($output_spec // {});
 4341: 
 4342: 	return($in_type eq $out_type);
 4343: }
 4344: 
 4345: # --------------------------------------------------
 4346: # _get_dominant_type
 4347: #
 4348: # Purpose:    Extract the most representative type
 4349: #             string from a spec hashref. For flat
 4350: #             output specs this is simply the 'type'
 4351: #             key. For multi-field input specs it is
 4352: #             the type of the first sub-field found
 4353: #             that declares one.
 4354: #
 4355: # Entry:      $spec - a spec hashref. May be a flat
 4356: #                     output spec ({ type => '...' })
 4357: #                     or a multi-field input spec
 4358: #                     ({ field => { type => '...' } }).
 4359: #                     May be undef or empty.
 4360: #
 4361: # Exit:       Returns a type string. Returns
 4362: #             $DEFAULT_FIELD_TYPE ('string') if no
 4363: #             type can be determined.
 4364: # --------------------------------------------------
 4365: sub _get_dominant_type {
  Mutants (Total: 2, Killed: 2, Survived: 0)
●4366 → 4377 → 4384 4366: 	my $spec = $_[0];
 4367: 
 4368: 	# Guard: return default for undef or non-hash input
 4369: 	return $DEFAULT_FIELD_TYPE
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4370: 		unless defined($spec) && ref($spec) eq 'HASH';
 4371: 
 4372: 	# Flat spec — type declared directly
 4373: 	return $spec->{'type'} if defined($spec->{'type'});
 4374: 
 4375: 	# Multi-field spec — return the type of the first
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4376: 	# sub-field that declares one
 4377: 	for my $field (keys %{$spec}) {
 4378: 		next unless ref($spec->{$field}) eq 'HASH';
 4379: 		return $spec->{$field}{'type'}
 4380: 			if defined($spec->{$field}{'type'});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4381: 	}
 4382: 
 4383: 	# No type found anywhere — return the safe default
 4384: 	return $DEFAULT_FIELD_TYPE;
 4385: }
 4386: 
 4387: # --------------------------------------------------
 4388: # _render_properties
 4389: #
 4390: # Purpose:    Render an arrayref of property definition
 4391: #             hashrefs (as produced by
 4392: #             _generate_transform_properties) into a
 4393: #             string of Perl source code suitable for
 4394: #             embedding in a generated test file.
 4395: #             The output uses Test::LectroTest::Compat
 4396: #             to run each property as a holds() check.
 4397: #
 4398: # Entry:      $properties - arrayref of property
 4399: #             hashrefs, each containing: name,
 4400: #             generator_spec, call_code,
 4401: #             property_checks, should_die,
 4402: #             should_warn, trials.
 4403: #             May be undef or an empty arrayref.
 4404: #
 4405: # Exit:       Returns a string of Perl source code.
 4406: #             Returns an empty string if $properties
 4407: #             is undef, not an arrayref, or empty.
 4408: #
 4409: # Notes:      The generated code uses 4-space
 4410: #             indentation deliberately — this is the
 4411: #             indentation style of the generated test
 4412: #             file, not of this module. Tabs are used
 4413: #             in this module's own source; spaces are
 4414: #             emitted into generated output for
 4415: #             readability of the produced test files.
 4416: # --------------------------------------------------
 4417: sub _render_properties {
●4418 → 4427 → 4454 4418: 	my $properties = $_[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4419: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4420: 	# Return empty string for absent or non-array input —
 4421: 	# callers treat '' as no property block to emit
 4422: 	return '' unless defined($properties) && ref($properties) eq 'ARRAY';
 4423: 	return '' unless @{$properties};
 4424: 
 4425: 	my $code = "use_ok('Test::LectroTest::Compat');\n\n";
 4426: 
 4427: 	for my $prop (@{$properties}) {
 4428: 		# Emit a labelled Property block for each transform property
 4429: 		$code .= "# Transform property: $prop->{'name'}\n";
 4430: 		$code .= "my \$$prop->{'name'} = Property {\n";
 4431: 		$code .= "    ##[ $prop->{'generator_spec'} ]##\n";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4432: 		$code .= "    \n";
 4433: 		$code .= "    my \$result = eval { $prop->{'call_code'} };\n";
 4434: 
 4435: 		if($prop->{'should_die'}) {
 4436: 			# For transforms that expect death, pass if the
 4437: 			# eval caught an exception
 4438: 			$code .= "    my \$died = defined(\$\@) && \$\@;\n";
 4439: 			$code .= "    \$died;\n";
 4440: 		} else {
 4441: 			# For normal transforms, pass only if no exception
 4442: 			# was thrown and all property checks hold
 4443: 			$code .= "    my \$error = \$\@;\n";
 4444: 			$code .= "    \n";
 4445: 			$code .= "    !\$error && (\n";
 4446: 			$code .= "        $prop->{'property_checks'}\n";
 4447: 			$code .= "    );\n";
 4448: 		}
 4449: 
 4450: 		$code .= "}, name => '$prop->{'name'}', trials => $prop->{'trials'};\n\n";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4451: 		$code .= "holds(\$$prop->{'name'});\n";
 4452: 	}
 4453: 
 4454: 	return $code;
 4455: }
 4456: 
 4457: # --------------------------------------------------
 4458: # _detect_transform_properties
 4459: #
 4460: # Purpose:    Automatically derive a list of testable
 4461: #             LectroTest property hashrefs from a
 4462: #             transform's input and output specs.
 4463: #             Detects numeric range constraints, exact
 4464: #             value matches, string length constraints,
 4465: #             type preservation, and definedness.
 4466: #
 4467: # Entry:      $transform_name - string name of the
 4468: #                               transform, used for
 4469: #                               heuristic matching
 4470: #                               (e.g. 'positive').
 4471: #             $input_spec     - the transform's input
 4472: #                               hashref, or the string
 4473: #                               'undef'.
 4474: #             $output_spec    - the transform's output
 4475: #                               hashref, or undef if
 4476: #                               absent.
 4477: #
 4478: # Exit:       Returns a list of property hashrefs,
 4479: #             each containing 'name' and 'code' keys.
 4480: #             Returns an empty list if no properties
 4481: #             can be detected or if $input_spec is
 4482: #             undef or the string 'undef'.
 4483: #
 4484: # Notes:      The 'positive' heuristic checks the
 4485: #             transform name case-insensitively against
 4486: #             $TRANSFORM_POSITIVE_PATTERN and adds a
 4487: #             non-negative constraint if matched.
 4488: #             This is intentionally a rough heuristic
 4489: #             rather than a precise semantic check.
 4490: # --------------------------------------------------
 4491: sub _detect_transform_properties {
●4492 → 4507 → 4537 4492: 	my ($transform_name, $input_spec, $output_spec) = @_;
 4493: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4494: 	my @properties;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4495: 
 4496: 	# Guard: skip undef input and the YAML scalar 'undef'
 4497: 	return @properties unless defined($input_spec);
 4498: 	return @properties if(!ref($input_spec) && $input_spec eq 'undef');
 4499: 
 4500: 	# Default output spec to empty hash so all key lookups
 4501: 	# below are safe regardless of what the schema provides
 4502: 	$output_spec //= {};
 4503: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4504: 	# --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4505: 	# Property 1: Output range constraints (numeric)
 4506: 	# --------------------------------------------------
 4507: 	if(_is_numeric_transform($input_spec, $output_spec)) {
 4508: 		if(defined($output_spec->{'min'})) {
 4509: 			my $min = $output_spec->{'min'};
 4510: 			push @properties, {
 4511: 				name => 'min_constraint',
 4512: 				code => "defined(\$result) && looks_like_number(\$result) && \$result >= $min",
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4513: 			};
 4514: 		}
 4515: 
 4516: 		if(defined($output_spec->{'max'})) {
 4517: 			my $max = $output_spec->{'max'};
 4518: 			push @properties, {
 4519: 				name => 'max_constraint',
 4520: 				code => "defined(\$result) && looks_like_number(\$result) && \$result <= $max",
 4521: 			};
 4522: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4523: 
 4524: 		# Heuristic: transforms named 'positive' (case-insensitive)
 4525: 		# imply a non-negative result constraint
 4526: 		if($transform_name =~ /$TRANSFORM_POSITIVE_PATTERN/i) {
 4527: 			push @properties, {
 4528: 				name => 'non_negative',
 4529: 				code => "defined(\$result) && looks_like_number(\$result) && \$result >= 0",
 4530: 			};
 4531: 		}
 4532: 	}
 4533: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4534: 	# --------------------------------------------------
 4535: 	# Property 2: Specific value output
 4536: 	# --------------------------------------------------
●4537 → 4537 → 4553 4537: 	if(defined($output_spec->{'value'})) {
 4538: 		my $expected = $output_spec->{'value'};
 4539: 
 4540: 		# Numeric refs use == for comparison; scalars use eq
 4541: 		# via perl_quote to produce the correct quoted literal
 4542: 		push @properties, {
 4543: 			name => 'exact_value',
 4544: 			code => ref($expected)
 4545: 				? "\$result == $expected"
 4546: 				: "\$result eq " . perl_quote($expected),
 4547: 		};
 4548: 	}
 4549: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4550: 	# --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4551: 	# Property 3: String length constraints
 4552: 	# --------------------------------------------------
●4553 → 4553 → 4592 4553: 	if(_is_string_transform($input_spec, $output_spec)) {
 4554: 		if(defined($output_spec->{'min'})) {
 4555: 			push @properties, {
 4556: 				name => 'min_length',
 4557: 				code => "length(\$result) >= $output_spec->{'min'}",

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4557_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4558: 			};
 4559: 		}
 4560: 
 4561: 		if(defined($output_spec->{'max'})) {
 4562: 			push @properties, {
 4563: 				name => 'max_length',
 4564: 				code => "length(\$result) <= $output_spec->{'max'}",

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4564_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4565: 			};
 4566: 		}
 4567: 
 4568: 		if(defined($output_spec->{'matches'})) {
 4569: 			my $pattern = $output_spec->{'matches'};
 4570: 
 4571: 			# See the matching comment in _schema_to_lectrotest_generator —
 4572: 			# compile first and re-embed via regexp_pattern() rather than

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4572_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4573: 			# splicing the raw string into qr/$pattern/, which would let
 4574: 			# an unescaped '/' break out of the delimiter.
 4575: 			my $compiled = ref($pattern) eq 'Regexp' ? $pattern : eval { qr/$pattern/ };
 4576: 			if($@ || !defined($compiled)) {
 4577: 				carp "Invalid matches pattern '$pattern' for transform '$transform_name': $@";
 4578: 			} else {
 4579: 				my ($pat, $mods) = regexp_pattern($compiled);
 4580: 				my $safe_re = "qr{$pat}" . ($mods // '');
 4581: 				push @properties, {
 4582: 					name => 'pattern_match',
 4583: 					code => "\$result =~ $safe_re",
 4584: 				};
 4585: 			}
 4586: 		}
 4587: 	}
 4588: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4589: 	# --------------------------------------------------
 4590: 	# Property 4: Type preservation
 4591: 	# --------------------------------------------------
●4592 → 4592 → 4611 4592: 	if(_same_type($input_spec, $output_spec)) {
 4593: 		my $type = _get_dominant_type($output_spec);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4594: 
 4595: 		# Only emit a numeric_type check for numeric types —
 4596: 		# string and other types have no equivalent simple check
 4597: 		if($type eq 'number' || $type eq 'integer' || $type eq 'float') {
 4598: 			push @properties, {
 4599: 				name => 'numeric_type',
 4600: 				code => 'looks_like_number($result)',
 4601: 			};
 4602: 		}
 4603: 	}
 4604: 
 4605: 	# --------------------------------------------------
 4606: 	# Property 5: Definedness
 4607: 	# --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4608: 	# Emit a defined() check for all transforms except those
 4609: 	# whose output type is explicitly 'undef' — those are
 4610: 	# expected to return nothing
●4611 → 4611 → 4618 4611: 	unless(($output_spec->{'type'} // '') eq 'undef') {
 4612: 		push @properties, {
 4613: 			name => 'defined',
 4614: 			code => 'defined($result)',
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4615: 		};
 4616: 	}
 4617: 
 4618: 	return @properties;
 4619: }
 4620: 
 4621: # --------------------------------------------------
 4622: # _process_custom_properties
 4623: #
 4624: # Purpose:    Process the 'properties' array from a
 4625: #             transform definition, resolving each
 4626: #             entry to either a named builtin property
 4627: #             (looked up from _get_builtin_properties)
 4628: #             or a custom property with inline code.
 4629: #
 4630: # Entry:      $properties_spec - arrayref of property
 4631: #                                definitions from the
 4632: #                                schema. Each element
 4633: #                                is either a string
 4634: #                                (builtin name) or a
 4635: #                                hashref with 'name'
 4636: #                                and 'code' fields.
 4637: #             $function        - name of the function
 4638: #                                under test.
 4639: #             $module          - module name, or undef
 4640: #                                for builtins.
 4641: #             $input_spec      - the transform's input
 4642: #                                spec hashref.
 4643: #             $output_spec     - the transform's output
 4644: #                                spec hashref.
 4645: #             $new             - defined if the function
 4646: #                                is an OO method; value
 4647: #                                is not used, only
 4648: #                                presence is checked.
 4649: #
 4650: # Exit:       Returns a list of property hashrefs,
 4651: #             each containing 'name', 'code', and
 4652: #             'description' keys.
 4653: #             Invalid or unrecognised entries are
 4654: #             skipped with a carp warning.
 4655: #
 4656: # Side effects: Carps on unrecognised builtin names,
 4657: #               missing code fields, and invalid
 4658: #               property definition types.
 4659: #
 4660: # Notes:      The sixth argument is $new (the OO
 4661: #             constructor signal), not the full schema
 4662: #             hashref. It is used only to determine
 4663: #             whether to emit OO-style call code for
 4664: #             builtin property templates.
 4665: # --------------------------------------------------
 4666: sub _process_custom_properties {
●4667 → 4672 → 4751 4667: 	my ($properties_spec, $function, $module, $input_spec, $output_spec, $new) = @_;
 4668: 
 4669: 	my @properties;
 4670: 	my $builtin_properties = _get_builtin_properties();
 4671: 
 4672: 	for my $prop_def (@{$properties_spec}) {
 4673: 		my $prop_name;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4674: 		my $prop_code;
 4675: 		my $prop_desc;
 4676: 
 4677: 		if(!ref($prop_def)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4678: 			# Plain string — look up as a named builtin property
 4679: 			$prop_name = $prop_def;
 4680: 
 4681: 			unless(exists($builtin_properties->{$prop_name})) {
 4682: 				carp "Unknown built-in property '$prop_name', skipping";
 4683: 				next;
 4684: 			}
 4685: 
 4686: 			my $builtin = $builtin_properties->{$prop_name};
 4687: 

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4687_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4688: 			# Build the argument list, respecting positional order
 4689: 			my @var_names = sort keys %{$input_spec};
 4690: 			my @args;
 4691: 			if(_has_positions($input_spec)) {
 4692: 				my @sorted = sort { $input_spec->{$a}{'position'} <=> $input_spec->{$b}{'position'} } @var_names;
 4693: 				@args = map { "\$$_" } @sorted;
 4694: 			} else {
 4695: 				@args = map { "\$$_" } @var_names;
 4696: 			}
 4697: 
 4698: 			# Build the call expression for the builtin template.

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4698_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4699: 			# $new here is the raw OO signal from the caller —
 4700: 			# defined means OO mode, undef means functional
 4701: 			my $call_code;
 4702: 			if($module && defined($new)) {
 4703: 				# OO mode — fresh object per trial
 4704: 				$call_code  = "my \$obj = new_ok('$module');";
 4705: 				$call_code .= "\$obj->$function";
 4706: 			} elsif($module && $module ne $MODULE_BUILTIN) {
 4707: 				# Functional mode with a named module
 4708: 				$call_code = "$module\::$function";
 4709: 			} else {
 4710: 				# Builtin or unqualified function call
 4711: 				$call_code = $function;
 4712: 			}
 4713: 			$call_code .= '(' . join(', ', @args) . ')';
 4714: 
 4715: 			# Instantiate the builtin's code template with the
 4716: 			# call expression and input variable list
 4717: 			$prop_code = $builtin->{'code_template'}->($function, $call_code, \@var_names);
 4718: 			$prop_desc = $builtin->{'description'};
 4719: 
 4720: 		} elsif(ref($prop_def) eq 'HASH') {
 4721: 			# Hashref — custom property with inline Perl code
 4722: 			$prop_name = $prop_def->{'name'} || 'custom_property';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4723: 			$prop_code = $prop_def->{'code'};
 4724: 			$prop_desc = $prop_def->{'description'} || "Custom property: $prop_name";
 4725: 
 4726: 			unless($prop_code) {
 4727: 				carp "Custom property '$prop_name' missing 'code' field, skipping";
 4728: 				next;
 4729: 			}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4730: 
 4731: 			# Sanity-check: code must contain at least a variable
 4732: 			# reference or a word character to be meaningful
 4733: 			unless($prop_code =~ /\$/ || $prop_code =~ /\w+/) {
 4734: 				carp "Custom property '$prop_name' code looks invalid: $prop_code";
 4735: 				next;
 4736: 			}
 4737: 
 4738: 		} else {
 4739: 			# Neither string nor hashref — unrecognised definition type
 4740: 			carp 'Invalid property definition: ', render_fallback($prop_def);
 4741: 			next;
 4742: 		}
 4743: 
 4744: 		push @properties, {
 4745: 			name        => $prop_name,
 4746: 			code        => $prop_code,
 4747: 			description => $prop_desc,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4748: 		};
 4749: 	}
 4750: 
 4751: 	return @properties;
 4752: }
 4753: 
 4754: =head1 NOTES
 4755: 
 4756: C<seed> and C<iterations> really should be within C<config>.
 4757: 
 4758: =head1 SEE ALSO
 4759: 
 4760: =over 4
 4761: 
 4762: =item * L<Test Dashboard|https://nigelhorne.github.io/App-Test-Generator/coverage/>
 4763: 
 4764: =item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>
 4765: 
 4766: =item * L<App::Test::Generator::SchemaExtractor> - Create schemas from Perl programs
 4767: 
 4768: =item * L<Params::Validate::Strict>: Schema Definition
 4769: 
 4770: =item * L<Params::Get>: Input validation
 4771: 
 4772: =item * L<Return::Set>: Output validation
 4773: 
 4774: =item * L<Test::LectroTest>
 4775: 
 4776: =item * L<Test::Most>
 4777: 
 4778: =item * L<YAML::XS>
 4779: 
 4780: =back
 4781: 
 4782: =head1 AUTHOR
 4783: 
 4784: Nigel Horne, C<< <njh at nigelhorne.com> >>
 4785: 
 4786: Portions of this module's initial design and documentation were created with the
 4787: assistance of AI.
 4788: 
 4789: =head1 SUPPORT
 4790: 
 4791: This module is provided as-is without any warranty.
 4792: 
 4793: You can find documentation for this module with the perldoc command.
 4794: 
 4795:     perldoc App::Test::Generator
 4796: 
 4797: You can also look for information at:
 4798: 
 4799: =over 4
 4800: 
 4801: =item * MetaCPAN
 4802: 
 4803: L<https://metacpan.org/release/App-Test-Generator>
 4804: 
 4805: =item * GitHub
 4806: 
 4807: L<https://github.com/nigelhorne/App-Test-Generator>
 4808: 
 4809: =item * CPANTS
 4810: 
 4811: L<http://cpants.cpanauthors.org/dist/App-Test-Generator>
 4812: 
 4813: =item * CPAN Testers' Matrix
 4814: 
 4815: L<http://matrix.cpantesters.org/?dist=App-Test-Generator>
 4816: 
 4817: =item * CPAN Testers Dependencies
 4818: 
 4819: L<http://deps.cpantesters.org/?module=App::Test::Generator>
 4820: 
 4821: =back
 4822: 
 4823: =head1 LICENCE AND COPYRIGHT
 4824: 
 4825: Copyright 2025-2026 Nigel Horne.
 4826: 
 4827: Usage is subject to the terms of GPL2.
 4828: If you use it,
 4829: please let me know.
 4830: 
 4831: =cut
 4832: 
 4833: 1;