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

					

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

				
NUM_BOUNDARY_1538_65_<: 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_1538_65_>: 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_1538_65_>=: 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' );

								
							
 1539: 
 1540: 	my $class = shift;
 1541: 	my $args = $_[0];
 1542: 
 1543: 	my ($schema_file, $test_file, $schema);
 1544: 	# Globals loaded from the user's conf (all optional except function maybe)
 1545: 	my ($module, $function, $new, $yaml_cases);
 1546: 	my ($seed, $iterations);
 1547: 
 1548: 	if((ref($args) eq 'HASH') || defined($_[2])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1549: 		# Modern API
 1550: 		my $params = Params::Validate::Strict::validate_strict({
 1551: 			args => Params::Get::get_params(undef, \@_),
 1552: 			schema => {
 1553: 				input_file => { type => 'string', optional => 1 },
 1554: 				schema_file => { type => 'string', optional => 1 },
 1555: 				output_file => { type => 'string', optional => 1 },
 1556: 				schema => { type => 'hashref', optional => 1 },
 1557: 				quiet => { type => 'boolean', optional => 1 },	# Not yet used
 1558: 			}
 1559: 		});
 1560: 		if($params->{'schema_file'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1561: 			$schema_file = $params->{'schema_file'};
 1562: 		} elsif($params->{'input_file'}) {
 1563: 			$schema_file = $params->{'input_file'};
 1564: 		} elsif($params->{'schema'}) {
 1565: 			$schema = $params->{'schema'};
 1566: 		} else {
 1567: 			croak(__PACKAGE__, ': Usage: generate(input_file|schema [, output_file]');
 1568: 		}
 1569: 		if(defined($schema_file)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1570: 			$schema = _load_schema($schema_file);
 1571: 		}
 1572: 		$test_file = $params->{'output_file'};
 1573: 	} else {
 1574: 		# Legacy API
 1575: 		($schema_file, $test_file) = @_;
 1576: 		if(defined($schema_file)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1577: 			$schema = _load_schema($schema_file);
 1578: 		} else {
 1579: 			croak 'Usage: generate(schema_file [, outfile])';
 1580: 		}
 1581: 	}
 1582: 
 1583: 	# Parse the schema file and load into our structures
●1584 → 1595 → 1598●1584 → 1595 → 0 1584: 	my %input = %{_load_schema_section($schema, 'input', $schema_file)};
 1585: 	my %output = %{_load_schema_section($schema, 'output', $schema_file)};
 1586: 	my %transforms = %{_load_schema_section($schema, 'transforms', $schema_file)};
 1587: 	my %accessor = %{_load_schema_section($schema, 'accessor', $schema_file)};
 1588: 
 1589: 	my %cases = %{$schema->{cases}} if(exists($schema->{cases}));
 1590: 	my %edge_cases = %{$schema->{edge_cases}} if(exists($schema->{edge_cases}));
 1591: 	my %type_edge_cases = %{$schema->{type_edge_cases}} if(exists($schema->{type_edge_cases}));
 1592: 
 1593: 	$module = $schema->{module} if(exists($schema->{module}) && length($schema->{module}));
 1594: 	$function = $schema->{function} if(exists($schema->{function}));
 1595: 	if(exists($schema->{new})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1596: 		$new = defined($schema->{'new'}) ? $schema->{new} : '_UNDEF';
 1597: 	}
●1598 → 1610 → 1624●1598 → 1610 → 0 1598: 	$yaml_cases = $schema->{yaml_cases} if(exists($schema->{yaml_cases}));
 1599: 	$seed = $schema->{seed} if(exists($schema->{seed}));
 1600: 	$iterations = $schema->{iterations} if(exists($schema->{iterations}));
 1601: 
 1602: 	my @edge_case_array = @{$schema->{edge_case_array}} if(exists($schema->{edge_case_array}));
 1603: 	_validate_config($schema);
 1604: 
 1605: 	my %config = %{$schema->{config}} if(exists($schema->{config}));
 1606: 
 1607: 	_normalize_config(\%config);
 1608: 
 1609: 	# Guess module name from config file if not set
 1610: 	if(!$module) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1611: 		if($schema_file) {

					

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

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

 1612: 			($module = basename($schema_file)) =~ s/\.(conf|pl|pm|yml|yaml)$//;
 1613: 			$module =~ s/-/::/g;
 1614: 			# Guard against Perl builtin function names being mistaken
 1615: 			# for module names — builtins have no module to load
 1616: 			if(_is_perl_builtin($module)) {

					

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

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

 1617: 				undef $module;
 1618: 			}
 1619: 		}
 1620: 	} elsif($module eq $MODULE_BUILTIN) {
 1621: 		undef $module;
 1622: 	}
 1623: 
●1624 → 1624 → 1629●1624 → 1624 → 0 1624: 	if($module && length($module) && ($module ne 'builtin')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1625: 		_validate_module($module, $schema_file);
 1626: 	}
 1627: 
 1628: 	# sensible defaults
●1629 → 1635 → 1656●1629 → 1635 → 0 1629: 	$function ||= 'run';
 1630: 	$iterations ||= DEFAULT_ITERATIONS;		 # default fuzz runs if not specified
 1631: 	$seed = undef if defined $seed && $seed eq '';	# treat empty as undef
 1632: 
 1633: 	# --- YAML corpus support (yaml_cases is filename string) ---
 1634: 	my %yaml_corpus_data;
 1635: 	if (defined $yaml_cases) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1636: 		croak("$yaml_cases: $!") if(!-f $yaml_cases);
 1637: 
 1638: 		my $yaml_data = LoadFile(Encode::decode('utf8', $yaml_cases));
 1639: 		if ($yaml_data && ref($yaml_data) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1640: 			# Validate that the corpus inputs are arrayrefs
 1641: 			# e.g: "FooBar": 	["foo_bar"]
 1642: 			# Skip only invalid entries:
 1643: 			for my $expected (keys %{$yaml_data}) {
 1644: 				my $outputs = $yaml_data->{$expected};
 1645: 				unless($outputs && (ref $outputs eq 'ARRAY')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1646: 					carp("$yaml_cases: $expected does not point to an array ref, ignoring");
 1647: 					next;
 1648: 				}
 1649: 				$yaml_corpus_data{$expected} = $outputs;
 1650: 			}
 1651: 		}
 1652: 	}
 1653: 
 1654: 	# Merge Perl %cases and YAML corpus safely
 1655: 	# my %all_cases = (%cases, %yaml_corpus_data);
●1656 → 1657 → 1663●1656 → 1657 → 0 1656: 	my %all_cases = (%yaml_corpus_data, %cases);
 1657: 	for my $k (keys %yaml_corpus_data) {
 1658: 		if (exists $cases{$k} && ref($cases{$k}) eq 'ARRAY' && ref($yaml_corpus_data{$k}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1659: 			$all_cases{$k} = [ @{$yaml_corpus_data{$k}}, @{$cases{$k}} ];
 1660: 		}
 1661: 	}
 1662: 
●1663 → 1663 → 1673●1663 → 1663 → 0 1663: 	if(my $hints = delete $schema->{_yamltest_hints}) {

					

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

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

 1664: 		if(my $boundaries = $hints->{boundary_values}) {

					

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

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

 1665: 			push @edge_case_array, @{$boundaries};
 1666: 		}
 1667: 		if(my $invalid = $hints->{invalid}) {

					

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

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

 1668: 			carp('TODO: handle yamltest_hints->invalid');
 1669: 		}
 1670: 	}
 1671: 
 1672: 	# If the schema says the type is numeric, normalize
●1673 → 1673 → 1683●1673 → 1673 → 0 1673: 	if ($schema->{type} && $schema->{type} =~ /^(integer|number|float)$/) {

					

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

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

 1674: 		for (@edge_case_array) {
 1675: 			next unless defined $_;
 1676: 			$_ += 0 if Scalar::Util::looks_like_number($_);
 1677: 		}
 1678: 	}
 1679: 
 1680: 	# Load relationships from the schema if present and well-formed.
 1681: 	# SchemaExtractor may set this to undef or an empty arrayref when
 1682: 	# no relationships were detected, so guard both existence and type.
●1683 → 1684 → 1692●1683 → 1684 → 0 1683: 	my @relationships;
 1684: 	if(exists($schema->{relationships}) && ref($schema->{relationships}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1685: 		@relationships = @{$schema->{relationships}};
 1686: 	}
 1687: 
 1688: 	# Serialise the relationships array from the schema into Perl source
 1689: 	# code for embedding in the generated test file. Each relationship
 1690: 	# type is rendered as a hashref in the @relationships array.
 1691: 
●1692 → 1695 → 1744●1692 → 1695 → 0 1692: 	my $relationships_code = '';
 1693: 
 1694: 	# Walk each relationship in the order SchemaExtractor produced them
 1695: 	for my $rel (@relationships) {
 1696: 		my $type = $rel->{type} // '';
 1697: 
 1698: 		# Mutually exclusive: both params being set should cause the method to die
 1699: 		if($type eq 'mutually_exclusive') {

					

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

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

 1700: 			$relationships_code .= "{ type => 'mutually_exclusive', params => [" .
 1701: 				join(', ', map { perl_quote($_) } @{$rel->{params}}) .
 1702: 				"] },\n";
 1703: 
 1704: 		# Required group: at least one of the params must be present
 1705: 		} elsif($type eq 'required_group') {
 1706: 			$relationships_code .= "{ type => 'required_group', params => [" .
 1707: 				join(', ', map { perl_quote($_) } @{$rel->{params}}) .
 1708: 				"], logic => " . perl_quote($rel->{logic} // 'or') . " },\n";
 1709: 
 1710: 		# Conditional requirement: if one param is set, another becomes mandatory
 1711: 		} elsif($type eq 'conditional_requirement') {
 1712: 			$relationships_code .= "{ type => 'conditional_requirement', if => " .
 1713: 				perl_quote($rel->{'if'}) . ", then_required => " .
 1714: 				perl_quote($rel->{then_required}) . " },\n";
 1715: 
 1716: 		# Dependency: one param requires another to also be present
 1717: 		} elsif($type eq 'dependency') {
 1718: 			$relationships_code .= "{ type => 'dependency', param => " .
 1719: 				perl_quote($rel->{param}) . ", requires => " .
 1720: 				perl_quote($rel->{requires}) . " },\n";
 1721: 
 1722: 		# Value constraint: one param being set forces another to a specific value
 1723: 		} elsif($type eq 'value_constraint') {
 1724: 			$relationships_code .= "{ type => 'value_constraint', if => " .
 1725: 				perl_quote($rel->{'if'}) . ", then => " .
 1726: 				perl_quote($rel->{then}) . ", operator => " .
 1727: 				perl_quote($rel->{operator}) . ", value => " .
 1728: 				perl_quote($rel->{value}) . " },\n";
 1729: 
 1730: 		# Value conditional: one param equalling a specific value requires another param
 1731: 		} elsif($type eq 'value_conditional') {
 1732: 			$relationships_code .= "{ type => 'value_conditional', if => " .
 1733: 				perl_quote($rel->{'if'}) . ", equals => " .
 1734: 				perl_quote($rel->{equals}) . ", then_required => " .
 1735: 				perl_quote($rel->{then_required}) . " },\n";
 1736: 
 1737: 		# Unknown type — warn and skip rather than emitting broken code
 1738: 		} else {
 1739: 			carp "Unknown relationship type '$type', skipping";
 1740: 		}
 1741: 	}
 1742: 
 1743: 	# Dedup the edge cases
●1744 → 1769 → 1774●1744 → 1769 → 0 1744: 	my %seen;
 1745: 	@edge_case_array = grep {
 1746: 		my $key = defined($_) ? (Scalar::Util::looks_like_number($_) ? "N:$_" : "S:$_") : 'U';
 1747: 		!$seen{$key}++;
 1748: 	} @edge_case_array;
 1749: 
 1750: 	# Sort the edge cases to keep it consistent across runs
 1751: 	@edge_case_array = sort {
 1752: 		return -1 if !defined $a;

					

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

				
BOOL_NEGATE_1752_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_1752_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' );

								
							
 1753: 		return 1 if !defined $b;

					

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

				
BOOL_NEGATE_1753_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_1753_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' );

								
							
 1754: 
 1755: 		my $na = Scalar::Util::looks_like_number($a);
 1756: 		my $nb = Scalar::Util::looks_like_number($b);
 1757: 
 1758: 		return $a <=> $b if $na && $nb;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1759: 		return -1 if $na;

					

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

				
BOOL_NEGATE_1759_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_1759_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' );

								
							
 1760: 		return 1 if $nb;

					

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

				
BOOL_NEGATE_1760_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_1760_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' );

								
							
 1761: 		return $a cmp $b;

					

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

				
BOOL_NEGATE_1761_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_1761_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' );

								
							
 1762: 	} @edge_case_array;
 1763: 
 1764: 	# render edge case maps for inclusion in the .t
 1765: 	my $edge_cases_code = render_arrayref_map(\%edge_cases);
 1766: 	my $type_edge_cases_code = render_arrayref_map(\%type_edge_cases);
 1767: 
 1768: 	my $edge_case_array_code = '';
 1769: 	if(scalar(@edge_case_array)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1770: 		$edge_case_array_code = join(', ', map { q_wrap($_) } @edge_case_array);
 1771: 	}
 1772: 
 1773: 	# Render configuration - all the values are integers for now, if that changes, wrap the $config{$key} in single quotes
●1774 → 1775 → 1791●1774 → 1775 → 0 1774: 	my $config_code = '';
 1775: 	foreach my $key (sort keys %config) {
 1776: 		# Skip nested structures like 'properties' - they're used during
 1777: 		# generation but don't need to be in the generated test
 1778: 		if(ref($config{$key}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1779: 			next;
 1780: 		}
 1781: 		if((!defined($config{$key})) || !$config{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1782: 			# YAML will strip the word 'false'
 1783: 			# e.g. in 'test_undef: false'
 1784: 			$config_code .= "'$key' => 0,\n";
 1785: 		} else {
 1786: 			$config_code .= "'$key' => $config{$key},\n";
 1787: 		}
 1788: 	}
 1789: 
 1790: 	# Render input/output
●1791 → 1792 → 1801●1791 → 1792 → 0 1791: 	my $input_code = '';
 1792: 	if(((scalar keys %input) == 1) && exists($input{'type'}) && !ref($input{'type'})) {

					

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

				
NUM_BOUNDARY_1792_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_1792_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1793: 		# %input = ( type => 'string' );
 1794: 		foreach my $key (sort keys %input) {
 1795: 			$input_code .= "'$key' => '$input{$key}',\n";
 1796: 		}
 1797: 	} else {
 1798: 		# %input = ( str => { type => 'string' } );
 1799: 		$input_code = render_hash(\%input);
 1800: 	}
●1801 → 1801 → 1818●1801 → 1801 → 0 1801: 	if(defined(my $re = $output{'matches'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1802: 		if(ref($re) ne 'Regexp') {

					

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

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

 1803: 			# Use eval to compile safely — qr/$re/ would interpolate
 1804: 			# the string first, corrupting patterns containing [ or \
 1805: 			my $compiled = eval { qr/$re/ };
 1806: 			if($@) {

					

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

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

 1807: 				carp("Invalid matches pattern '$re': $@");
 1808: 			} else {
 1809: 				$output{'matches'} = $compiled;
 1810: 			}
 1811: 		}
 1812: 	}
 1813: 
 1814: 	# Compile nomatch pattern to a Regexp object so it renders
 1815: 	# as qr{} in the generated test rather than a raw string.
 1816: 	# Without this, patterns containing [ or other regex
 1817: 	# metacharacters cause compilation failures in validators
●1818 → 1818 → 1831●1818 → 1818 → 0 1818: 	if(defined(my $re = $output{'nomatch'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1819: 		if(ref($re) ne 'Regexp') {

					

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

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

 1820: 			# Use eval to compile safely — qr/$re/ would interpolate
 1821: 			# the string first, corrupting patterns containing [ or \
 1822: 			my $compiled = eval { qr/$re/ };
 1823: 			if($@) {

					

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

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

 1824: 				carp("Invalid nomatch pattern '$re': $@");
 1825: 			} else {
 1826: 				$output{'nomatch'} = $compiled;
 1827: 			}
 1828: 		}
 1829: 	}
 1830: 
●1831 → 1835 → 1853●1831 → 1835 → 0 1831: 	my $output_code = render_args_hash(\%output);
 1832: 	my $new_code = ($new && (ref $new eq 'HASH')) ? render_args_hash($new) : '';
 1833: 
 1834: 	my $transforms_code;
 1835: 	if(keys %transforms) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1836: 		foreach my $transform(keys %transforms) {
 1837: 			my $properties = render_fallback($transforms{$transform}->{'properties'});
 1838: 
 1839: 			if($transforms_code) {

					

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

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

 1840: 				$transforms_code .= "},\n";
 1841: 			}
 1842: 			$transforms_code .= "$transform => {\n" .
 1843: 				"\t'input' => { " .
 1844: 				render_args_hash($transforms{$transform}->{'input'}) .
 1845: 				"\t}, 'output' => { " .
 1846: 				render_args_hash($transforms{$transform}->{'output'}) .
 1847: 				"\t}, 'properties' => $properties\n" .
 1848: 				"\t,\n";
 1849: 		}
 1850: 		$transforms_code .= "}\n";
 1851: 	}
 1852: 
●1853 → 1856 → 1873●1853 → 1856 → 0 1853: 	my $transform_properties_code = '';
 1854: 	my $use_properties = 0;
 1855: 
 1856: 	if (keys %transforms && ($config{properties}{enable} // 0)) {

					

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

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

 1857: 		$use_properties = 1;
 1858: 
 1859: 		# Generate property-based tests for transforms
 1860: 		my $properties = _generate_transform_properties(
 1861: 			\%transforms,
 1862: 			$function,
 1863: 			$module,
 1864: 			\%input,
 1865: 			\%config,
 1866: 			$new
 1867: 		);
 1868: 
 1869: 		# Convert to code for template
 1870: 		$transform_properties_code = _render_properties($properties);
 1871: 	}
 1872: 
●1873 → 1873 → 1892●1873 → 1873 → 0 1873: 	if(keys %accessor) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1874: 		# Sanity test
 1875: 		my $property = $accessor{property};
 1876: 		my $type = $accessor{type};
 1877: 
 1878: 		if(!defined($new)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1879: 			croak("BUG: $property: accessor $type can only work on an object, incorrectly tagged as $type");
 1880: 		}
 1881: 		if($type eq 'getset') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1882: 			if(scalar(keys %input) != 1) {

					

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

				
NUM_BOUNDARY_1882_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_1882_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1883: 				croak("BUG: $property: getset must take one input argument, incorrectly tagged as getset");
 1884: 			}
 1885: 			if(scalar(keys %output) == 0) {

					

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

				
NUM_BOUNDARY_1885_28_!=: 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_1885_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1886: 				croak("BUG: $property: getset must give one output, incorrectly tagged as getset");
 1887: 			}
 1888: 		}
 1889: 	}
 1890: 
 1891: 	# Setup / call code (always load module)
●1892 → 1896 → 1963●1892 → 1896 → 0 1892: 	my $setup_code = ($module) ? "BEGIN { use_ok('$module') }" : '';
 1893: 	my $call_code;	# Code to call the function being test when used with named arguments
 1894: 	my $position_code;	# Code to call the function being test when used with position arguments
 1895: 	my $has_positions = _has_positions(\%input);
 1896: 	if(defined($new) && defined($module)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1897: 		# keep use_ok regardless (user found earlier issue)
 1898: 		if($new_code eq '') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1899: 			$new_code = "new_ok('$module')";
 1900: 		} else {
 1901: 			$new_code = "new_ok('$module' => [ { $new_code } ] )";
 1902: 		}
 1903: 		$setup_code .= "\nmy \$obj = $new_code;";
 1904: 		if($has_positions) {

					

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

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

 1905: 			$position_code = "\$result = (scalar(\@alist) == 1) ? \$obj->$function(\$alist[0]) : (scalar(\@alist) == 0) ? \$obj->$function() : \$obj->$function(\@alist);";
 1906: 			if(defined($accessor{type})) {

					

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

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

 1907: 				if($accessor{type} eq 'getter') {

					

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

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

 1908: 					$position_code .= "my \$prev_value = \$obj->{$accessor{property}};";
 1909: 				} elsif($accessor{type} eq 'getset') {
 1910: 					$position_code .= 'if(scalar(@alist) == 1) { ';
 1911: 					$position_code .= "cmp_ok(\$result, 'eq', \$alist[0], 'getset function returns what was put in'); ok(\$obj->$function() eq \$result, 'test getset accessor');";
 1912: 					$position_code .= '}';
 1913: 				}
 1914: 				if(($accessor{type} eq 'getset') || ($accessor{type} eq 'getter')) {

					

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

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

 1915: 					# Since Perl doesn't support data encapsulation, we can test the getter returns the correct item
 1916: 					$position_code .= 'if(scalar(@alist) == 1) { ';
 1917: 					$position_code .= "cmp_ok(\$result, 'eq', \$obj->{$accessor{property}}, 'getset function returns correct item');";
 1918: 					if($accessor{type} eq 'getter') {

					

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

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

 1919: 						$position_code .= "if(defined(\$prev_value)) { cmp_ok(\$result, 'eq', \$prev_value, 'getter does not change value'); } ";
 1920: 					}
 1921: 					$position_code .= '}';
 1922: 				}
 1923: 				if($output{'_returns_self'}) {

					

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

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

 1924: 					croak("$accessor{type} for $accessor{property} cannot return \$self");
 1925: 				}
 1926: 			}
 1927: 		} else {
 1928: 			$call_code = "\$result = \$obj->$function(\$input);";
 1929: 			if($output{'_returns_self'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1930: 				$call_code .= "ok(defined(\$result)); ok(\$result eq \$obj, '$function returns self')";
 1931: 			} elsif(defined($accessor{type}) && ($accessor{type} eq 'getset')) {
 1932: 				$call_code .= "ok(\$obj->$function() eq \$result, 'test getset accessor');"
 1933: 			}
 1934: 			if(scalar(keys %input) == 0) {

					

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

				
NUM_BOUNDARY_1934_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_1934_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1935: 				if(defined($accessor{type}) && ($accessor{type} eq 'getter')) {

					

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

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

 1936: 					$call_code .= "cmp_ok(\$result, 'eq', \$obj->{$accessor{property}}, 'getter function returns correct item') if(defined(\$result));";
 1937: 				}
 1938: 			}
 1939: 		}
 1940: 	} elsif(defined($module) && length($module)) {
 1941: 		if($function eq 'new') {

					

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

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

 1942: 			if($has_positions) {

					

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

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

 1943: 				$position_code = "\$result = (scalar(\@alist) == 1) ? ${module}\->$function(\$alist[0]) : (scalar(\@alist) == 0) ? ${module}\->$function() : ${module}\->$function(\@alist);";
 1944: 			} else {
 1945: 				$call_code = "\$result = ${module}\->$function(\$input);";
 1946: 			}
 1947: 		} else {
 1948: 			if($has_positions) {

					

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

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

 1949: 				$position_code = "\$result = (scalar(\@alist) == 1) ? ${module}::$function(\$alist[0]) : (scalar(\@alist) == 0) ? ${module}::$function() : ${module}::$function(\@alist);";
 1950: 			} else {
 1951: 				$call_code = "\$result = ${module}::$function(\$input);";
 1952: 			}
 1953: 		}
 1954: 	} else {
 1955: 		if($has_positions) {

					

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

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

 1956: 			$position_code = "\$result = $function(\@alist);";
 1957: 		} else {
 1958: 			$call_code = "\$result = $function(\$input);";
 1959: 		}
 1960: 	}
 1961: 
 1962: 	# Build static corpus code
●1963 → 1964 → 2060●1963 → 1964 → 0 1963: 	my $corpus_code = '';
 1964: 	if (%all_cases) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1965: 		$corpus_code = "\n# --- Static Corpus Tests ---\n" .
 1966: 			"diag('Running " . scalar(keys %all_cases) . " corpus tests');\n";
 1967: 
 1968: 		for my $expected (sort keys %all_cases) {
 1969: 			my $inputs = $all_cases{$expected};
 1970: 			next unless($inputs);
 1971: 
 1972: 			my $expected_str = perl_quote($expected);
 1973: 			my $status = ((ref($inputs) eq 'HASH') && $inputs->{'_STATUS'}) // 'OK';
 1974: 			if($expected_str eq "'_STATUS:DIES'") {

					

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

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

 1975: 				$status = 'DIES';
 1976: 			} elsif($expected_str eq "'_STATUS:WARNS'") {
 1977: 				$status = 'WARNS';
 1978: 			}
 1979: 
 1980: 			if(ref($inputs) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1981: 				$inputs = $inputs->{'input'};
 1982: 			}
 1983: 			my $input_str;
 1984: 			if(ref($inputs) eq 'ARRAY') {

					

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

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

 1985: 				$input_str = join(', ', map { perl_quote($_) } @{$inputs});
 1986: 			} elsif(ref($inputs) eq 'HASH') {
 1987: 				$input_str = Dumper($inputs);
 1988: 				$input_str =~ s/\$VAR1 =//;
 1989: 				$input_str =~ s/;//;
 1990: 				$input_str =~ s/=> 'undef'/=> undef/gms;
 1991: 			} else {
 1992: 				$input_str = $inputs;
 1993: 			}
 1994: 			if(($input_str eq 'undef') && (!$config{'test_undef'})) {

					

					
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: 				carp('corpus case set to undef, yet test_undef is not set in config');
 1996: 			}
 1997: 			if($new) {

					

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

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

 1998: 				if($status eq 'DIES') {

					

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

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

 1999: 					$corpus_code .= "dies_ok { \$obj->$function($input_str) } " .
 2000: 							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") dies';\n";
 2001: 				} elsif($status eq 'WARNS') {
 2002: 					$corpus_code .= "warnings_exist { \$obj->$function($input_str) } qr/./, " .
 2003: 							"'$function(" . join(', ', map { $_ // '' } @$inputs ) . ") warns';\n";
 2004: 				} else {
 2005: 					my $desc = sprintf("$function(%s) returns %s",
 2006: 						perl_quote(join(', ', map { $_ // '' } @$inputs )),
 2007: 						$expected_str
 2008: 					);
 2009: 					if(($output{'type'} // '') eq 'boolean') {

					

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

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

 2010: 						if($expected_str eq '1') {

					

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

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

 2011: 							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2012: 						} elsif($expected_str eq '0') {
 2013: 							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2014: 						} else {
 2015: 							croak("Boolean is expected to return $expected_str");
 2016: 						}
 2017: 					} else {
 2018: 						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
 2019: 					}
 2020: 				}
 2021: 			} else {
 2022: 				if($status eq 'DIES') {

					

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

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

 2023: 					if($module) {

					

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

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

 2024: 						$corpus_code .= "dies_ok { $module\::$function($input_str) } " .
 2025: 							"'Corpus $expected dies';\n";
 2026: 					} else {
 2027: 						$corpus_code .= "dies_ok { $function($input_str) } " .
 2028: 							"'Corpus $expected dies';\n";
 2029: 					}
 2030: 				} elsif($status eq 'WARNS') {
 2031: 					if($module) {

					

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

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

 2032: 						$corpus_code .= "warnings_exist { $module\::$function($input_str) } qr/./, " .
 2033: 							"'Corpus $expected warns';\n";
 2034: 					} else {
 2035: 						$corpus_code .= "warnings_exist { $function($input_str) } qr/./, " .
 2036: 							"'Corpus $expected warns';\n";
 2037: 					}
 2038: 				} else {
 2039: 					my $desc = sprintf("$function(%s) returns %s",
 2040: 						perl_quote((ref $inputs eq 'ARRAY') ? (join(', ', map { $_ // '' } @{$inputs})) : $inputs),
 2041: 						$expected_str
 2042: 					);
 2043: 					if(($output{'type'} // '') eq 'boolean') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2044: 						if($expected_str eq '1') {

					

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

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

 2045: 							$corpus_code .= "ok(\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2046: 						} elsif($expected_str eq '0') {
 2047: 							$corpus_code .= "ok(!\$obj->$function($input_str), " . q_wrap($desc) . ");\n";
 2048: 						} else {
 2049: 							croak("Boolean is expected to return $expected_str");
 2050: 						}
 2051: 					} else {
 2052: 						$corpus_code .= "is(\$obj->$function($input_str), $expected_str, " . q_wrap($desc) . ");\n";
 2053: 					}
 2054: 				}
 2055: 			}
 2056: 		}
 2057: 	}
 2058: 
 2059: 	# Prepare seed/iterations code fragment for the generated test
●2060 → 2061 → 2067●2060 → 2061 → 0 2060: 	my $seed_code = '';
 2061: 	if (defined $seed) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2062: 		# ensure integer-ish
 2063: 		$seed = int($seed);
 2064: 		$seed_code = "srand($seed);\n";
 2065: 	}
 2066: 
●2067 → 2105 → 0 2067: 	my $determinism_code = 'my $result2;' .
 2068: 		'eval { $result2 = do { ' . (defined($position_code) ? $position_code : $call_code) . " }; };\n" .
 2069: 		'is_deeply($result2, $result, "deterministic result for same input");' .
 2070: 		"\n";
 2071: 
 2072: 	# Generate the test content
 2073: 	my $tt = Template->new({ ENCODING => 'utf8', TRIM => 1 });
 2074: 
 2075: 	# Read template from DATA handle
 2076: 	my $template_package = __PACKAGE__ . '::Template';
 2077: 	my $template = $template_package->get_data_section('test.tt');
 2078: 
 2079: 	my $vars = {
 2080: 		setup_code => $setup_code,
 2081: 		edge_cases_code => $edge_cases_code,
 2082: 		edge_case_array_code => $edge_case_array_code,
 2083: 		type_edge_cases_code => $type_edge_cases_code,
 2084: 		config_code => $config_code,
 2085: 		seed_code => $seed_code,
 2086: 		input_code => $input_code,
 2087: 		output_code => $output_code,
 2088: 		transforms_code => $transforms_code,
 2089: 		corpus_code => $corpus_code,
 2090: 		call_code => $call_code,
 2091: 		position_code => $position_code,
 2092: 		determinism_code => $determinism_code,
 2093: 		function => $function,
 2094: 		iterations_code => int($iterations),
 2095: 		use_properties => $use_properties,
 2096: 		transform_properties_code => $transform_properties_code,
 2097: 		property_trials => $config{properties}{trials} // DEFAULT_PROPERTY_TRIALS,
 2098: 		relationships_code => $relationships_code,
 2099: 		module => $module
 2100: 	};
 2101: 
 2102: 	my $test;
 2103: 	$tt->process($template, $vars, \$test) or croak($tt->error());
 2104: 
 2105: 	if ($test_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2106: 		open my $fh, '>:encoding(UTF-8)', $test_file or croak "Cannot open $test_file: $!";
 2107: 		print $fh "$test\n";
 2108: 		close $fh;
 2109: 		if($module) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2110: 			print "Generated $test_file for $module\::$function with fuzzing + corpus support\n";
 2111: 		} else {
 2112: 			print "Generated $test_file for $function with fuzzing + corpus support\n";
 2113: 		}
 2114: 	} else {
 2115: 		print "$test\n";
 2116: 	}
 2117: }
 2118: 
 2119: # --- Helpers for rendering data structures into Perl code for the generated test ---
 2120: 
 2121: # --------------------------------------------------
 2122: # _is_perl_builtin
 2123: #
 2124: # Purpose:    Return true if a string is the name of
 2125: #             a Perl core builtin function, to prevent
 2126: #             it being used as a module name in
 2127: #             use_ok() calls in generated tests.
 2128: #
 2129: # Entry:      $name - the string to check.
 2130: # Exit:       Returns 1 if builtin, 0 otherwise.
 2131: # Side effects: None.
 2132: # --------------------------------------------------
 2133: sub _is_perl_builtin {
 2134: 	my $name = $_[0];
 2135: 	return 0 unless defined $name;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2136: 
 2137: 	state %BUILTINS = map { $_ => 1 } qw(
 2138: 		abs accept alarm atan2 bind binmode bless
 2139: 		caller chdir chmod chomp chop chown chr chroot
 2140: 		close closedir connect cos crypt
 2141: 		dbmclose dbmopen defined delete die do dump
 2142: 		each endgrent endhostent endnetent endprotoent endpwent endservent
 2143: 		eof eval exec exists exit exp
 2144: 		fcntl fileno flock fork format formline
 2145: 		getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname
 2146: 		gethostent getlogin getnetbyaddr getnetbyname getnetent
 2147: 		getpeername getpgrp getppid getpriority getprotobyname
 2148: 		getprotobynumber getprotoent getpwent getpwnam getpwuid
 2149: 		getservbyname getservbyport getservent getsockname getsockopt
 2150: 		glob gmtime goto grep
 2151: 		hex
 2152: 		index int ioctl
 2153: 		join
 2154: 		keys kill
 2155: 		last lc lcfirst length link listen local localtime log lstat
 2156: 		map mkdir msgctl msgget msgrcv msgsnd my
 2157: 		next no
 2158: 		oct open opendir ord our
 2159: 		pack pipe pop pos print printf prototype push
 2160: 		quotemeta
 2161: 		rand read readdir readline readlink readpipe recv redo
 2162: 		ref rename require reset return reverse rewinddir rindex rmdir
 2163: 		say scalar seek seekdir select semctl semget semop send
 2164: 		setgrent sethostent setnetent setpgrp setpriority setprotoent
 2165: 		setpwent setservent setsockopt shift shmctl shmget shmread
 2166: 		shmwrite shutdown sin sleep socket socketpair sort splice split
 2167: 		sprintf sqrt srand stat study sub substr symlink syscall
 2168: 		sysopen sysread sysseek system syswrite
 2169: 		tell telldir tie tied time times truncate
 2170: 		uc ucfirst umask undef unlink unpack unshift untie use
 2171: 		utime values vec wait waitpid wantarray warn write
 2172: 	);
 2173: 	return $BUILTINS{lc $name} // 0;
 2174: }
 2175: 
 2176: # --------------------------------------------------
 2177: # _load_schema
 2178: #
 2179: # Load and parse a schema file using
 2180: #     Config::Abstraction, returning the
 2181: #     schema as a hashref.
 2182: #
 2183: # Entry:      $schema_file - path to the schema file.
 2184: #             Must be defined, non-empty, and readable.
 2185: #
 2186: # Exit:       Returns a hashref of the parsed schema
 2187: #             with a '_source' key added containing
 2188: #             the originating file path.
 2189: #             Croaks on any error.
 2190: #
 2191: # Side effects: Reads from the filesystem.
 2192: #
 2193: # Notes:      Legacy Perl-file configs (containing
 2194: #             '$module' or 'our $module' keys) are
 2195: #             rejected with a clear error. Config::
 2196: #             Abstraction is used rather than require()
 2197: #             to avoid executing arbitrary code from
 2198: #             user-supplied config files.
 2199: # --------------------------------------------------
 2200: sub _load_schema {
●2201 → 2215 → 2234●2201 → 2215 → 0 2201: 	my $schema_file = $_[0];
 2202: 
 2203: 	# Validate the argument before touching the filesystem
 2204: 	croak(__PACKAGE__, ': Usage: _load_schema($schema_file)') unless defined $schema_file;
 2205: 
 2206: 	croak(__PACKAGE__, ': _load_schema given empty filename') unless length($schema_file);
 2207: 
 2208: 	# Confirm the file exists and is readable before attempting
 2209: 	# to load it — gives a clearer error than Config::Abstraction would
 2210: 	croak(__PACKAGE__, ": _load_schema($schema_file): $!") unless -r $schema_file;
 2211: 
 2212: 	# Load configuration via Config::Abstraction which supports
 2213: 	# YAML, JSON, and other formats without executing arbitrary code.
 2214: 	# no_fixate prevents automatic type coercion that could alter values
 2215: 	if(my $schema = Config::Abstraction->new(
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2216: 		config_dirs  => ['.', ''],
 2217: 		config_file  => $schema_file,
 2218: 		no_fixate    => 1,
 2219: 	)) {
 2220: 		if($schema = $schema->all()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2221: 			# Detect legacy Perl config files by the presence of
 2222: 			# variable declaration keys — these are no longer supported
 2223: 			if(exists($schema->{$LEGACY_PERL_KEY_1}) ||
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2224: 			   exists($schema->{$LEGACY_PERL_KEY_2})) {
 2225: 				croak("$schema_file: Loading perl files as configs is no longer supported");
 2226: 			}
 2227: 
 2228: 			# Tag the schema with its source path for error messages
 2229: 			$schema->{$SOURCE_KEY} = $schema_file;
 2230: 			return $schema;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2231: 		}
 2232: 	}
 2233: 
●[NOT COVERED] 2234 → 2234 → 0 2234: 	croak "Failed to load schema from $schema_file";
 2235: }
 2236: 
 2237: # --------------------------------------------------
 2238: # _load_schema_section
 2239: #
 2240: # Purpose:    Extract a named section from a parsed
 2241: #             schema hashref, validating that it is
 2242: #             a hashref if present.
 2243: #
 2244: # Entry:      $schema      - the full parsed schema hashref.
 2245: #             $section     - name of the section to extract
 2246: #                            (e.g. 'input', 'output').
 2247: #             $schema_file - path of the schema file,
 2248: #                            used in error messages only.
 2249: #
 2250: # Exit:       Returns the section hashref if present,
 2251: #             or an empty hashref {} if absent.
 2252: #             Croaks if the section exists but is not
 2253: #             a hashref (and not the string 'undef').
 2254: #
 2255: # Side effects: None.
 2256: #
 2257: # Notes:      The string 'undef' is treated as an
 2258: #             absent section — callers that set a
 2259: #             section to 'undef' in YAML get the same
 2260: #             result as omitting it entirely.
 2261: # --------------------------------------------------
 2262: sub _load_schema_section {
 2263: 	my ($schema, $section, $schema_file) = @_;
 2264: 
 2265: 	# Section absent — return empty hash as the safe default
 2266: 	return {} unless exists $schema->{$section};
 2267: 
 2268: 	# Section present and is a hashref — return it directly
 2269: 	return $schema->{$section}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2270: 		if ref($schema->{$section}) eq 'HASH';
 2271: 
 2272: 	# Treat the YAML scalar 'undef' as equivalent to absent
 2273: 	return {}
 2274: 		if defined($schema->{$section}) &&
 2275: 		   $schema->{$section} eq 'undef';
 2276: 
 2277: 	# Section present but wrong type — croak with a clear message
 2278: 	# showing what type was found so the user can fix their schema
 2279: 	croak(
 2280: 		"$schema_file: $section should be a hash, not ",
 2281: 		ref($schema->{$section}) || $schema->{$section}
 2282: 	);
 2283: }
 2284: 
 2285: # --------------------------------------------------
 2286: # _validate_config
 2287: #
 2288: # Purpose:    Validate the top-level schema hashref
 2289: #             loaded from a schema file, checking that
 2290: #             required fields are present and that all
 2291: #             input parameters, types, positions, and
 2292: #             transform properties are well-formed.
 2293: #
 2294: # Entry:      $schema - the full parsed schema hashref
 2295: #             as returned by _load_schema().
 2296: #
 2297: # Exit:       Returns nothing on success.
 2298: #             Croaks on any structural error.
 2299: #             Carps on non-fatal warnings (unknown
 2300: #             semantic types, position gaps, missing
 2301: #             input/output definitions).
 2302: #
 2303: # Side effects: May delete $schema->{input} if its
 2304: #               value is the string 'undef'.
 2305: #
 2306: # Notes:      The parameter is named $schema throughout
 2307: #             to distinguish the top-level schema from
 2308: #             the nested config sub-hash. _validate_config
 2309: #             is called before _normalize_config so config
 2310: #             boolean normalisation has not yet occurred.
 2311: # --------------------------------------------------
 2312: sub _validate_config {
●2313 → 2317 → 2323●2313 → 2317 → 0 2313: 	my $schema = $_[0];
 2314: 
 2315: 	# At least one of module or function must be present —
 2316: 	# without these we cannot generate any meaningful test
 2317: 	if(!defined($schema->{'module'}) && !defined($schema->{'function'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2318: 		croak('At least one of function and module must be defined');
 2319: 	}
 2320: 
 2321: 	# Warn if neither input nor output is defined — a few
 2322: 	# generic tests can still be generated but it is unusual
●2323 → 2323 → 2328●2323 → 2323 → 0 2323: 	if(!defined($schema->{'input'}) && !defined($schema->{'output'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2324: 		carp('Neither input nor output is defined, only a few tests will be generated');
 2325: 	}
 2326: 
 2327: 	# Normalise input: the string 'undef' means no input defined
●2328 → 2328 → 2337●2328 → 2328 → 0 2328: 	if($schema->{'input'} && ref($schema->{input}) ne 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2329: 		if($schema->{'input'} eq 'undef') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2330: 			delete $schema->{'input'};
 2331: 		} else {
 2332: 			croak("Invalid input specification: expected hash, got '$schema->{'input'}'");
 2333: 		}
 2334: 	}
 2335: 
 2336: 	# Validate each input parameter if input is defined
●2337 → 2337 → 2344●2337 → 2337 → 0 2337: 	if($schema->{input}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2338: 		_validate_input_params($schema);
 2339: 		_validate_input_positions($schema);
 2340: 		_validate_input_semantics($schema);
 2341: 	}
 2342: 
 2343: 	# Validate transform property definitions if present
●2344 → 2344 → 2349●2344 → 2344 → 0 2344: 	if(exists($schema->{transforms}) && ref($schema->{transforms}) eq 'HASH') {

					

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

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

 2345: 		_validate_transform_properties($schema);
 2346: 	}
 2347: 
 2348: 	# Validate any nested config sub-hash keys against known types
●2349 → 2349 → 0 2349: 	if(ref($schema->{config}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2350: 		for my $k (keys %{$schema->{'config'}}) {
 2351: 			# CONFIG_TYPES is the authoritative list of valid keys
 2352: 			croak "unknown config setting '$k'"
 2353: 				unless grep { $_ eq $k } CONFIG_TYPES;
 2354: 		}
 2355: 	}
 2356: }
 2357: 
 2358: # --------------------------------------------------
 2359: # _validate_input_params
 2360: #
 2361: # Purpose:    Validate type specifications for each
 2362: #             named input parameter.
 2363: #
 2364: # Entry:      $schema - the full parsed schema hashref.
 2365: #             $schema->{input} must be a hashref.
 2366: #
 2367: # Exit:       Returns nothing. Croaks on invalid type.
 2368: # Side effects: None.
 2369: # --------------------------------------------------
 2370: sub _validate_input_params {
●2371 → 2373 → 0 2371: 	my $schema = $_[0];
 2372: 
 2373: 	for my $param (keys %{$schema->{input}}) {
 2374: 		# Catch empty parameter names — these would produce
 2375: 		# broken Perl variable names in the generated test
 2376: 		croak 'Empty input parameter name'
 2377: 			unless length($param);
 2378: 
 2379: 		my $spec = $schema->{input}{$param};
 2380: 
 2381: 		# Validate the type field — required for all parameters
 2382: 		if(ref($spec)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2383: 			croak("Missing type for parameter '$param'")
 2384: 				unless defined $spec->{type};
 2385: 			croak("Invalid type '$spec->{type}' for parameter '$param'")
 2386: 				unless _valid_type($spec->{type});
 2387: 		} else {
 2388: 			croak("Invalid type '$spec' for parameter '$param'")
 2389: 				unless _valid_type($spec);
 2390: 		}
 2391: 	}
 2392: }
 2393: 
 2394: # --------------------------------------------------
 2395: # _validate_input_positions
 2396: #
 2397: # Purpose:    Validate positional argument declarations
 2398: #             in the input schema — positions must be
 2399: #             non-negative integers with no duplicates,
 2400: #             and either all or no parameters must have
 2401: #             positions.
 2402: #
 2403: # Entry:      $schema - the full parsed schema hashref.
 2404: #             $schema->{input} must be a hashref.
 2405: #
 2406: # Exit:       Returns nothing. Croaks on invalid or
 2407: #             duplicate positions. Carps on gaps.
 2408: # Side effects: None.
 2409: # --------------------------------------------------
 2410: sub _validate_input_positions {
●2411 → 2416 → 2437●2411 → 2416 → 0 2411: 	my $schema = $_[0];
 2412: 
 2413: 	my $has_positions = 0;
 2414: 	my %positions;
 2415: 
 2416: 	for my $param (keys %{$schema->{input}}) {
 2417: 		my $spec = $schema->{input}{$param};
 2418: 
 2419: 		# Only process params that explicitly declare a position
 2420: 		next unless ref($spec) eq 'HASH' && defined($spec->{position});
 2421: 
 2422: 		$has_positions = 1;
 2423: 		my $pos = $spec->{position};
 2424: 
 2425: 		# Position must be a non-negative integer
 2426: 		croak "Position for '$param' must be a non-negative integer"
 2427: 			unless $pos =~ /^\d+$/;
 2428: 
 2429: 		# Duplicate positions would produce ambiguous generated tests
 2430: 		croak "Duplicate position $pos for parameters '$positions{$pos}' and '$param'"
 2431: 			if exists $positions{$pos};
 2432: 
 2433: 		$positions{$pos} = $param;
 2434: 	}
 2435: 
 2436: 	# If any param has a position, all params must have one
●2437 → 2437 → 0 2437: 	if($has_positions) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2438: 		for my $param (keys %{$schema->{input}}) {
 2439: 			my $spec = $schema->{input}{$param};
 2440: 			unless(ref($spec) eq 'HASH' && defined($spec->{position})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2441: 				croak "Parameter '$param' missing position " .
 2442: 					'(all params must have positions if any do)';
 2443: 			}
 2444: 		}
 2445: 
 2446: 		# Check for gaps — positions must be a contiguous sequence
 2447: 		# starting at 0, otherwise the generated test will be wrong
 2448: 		my @sorted = sort { $a <=> $b } keys %positions;
 2449: 		for my $i (0 .. $#sorted) {
 2450: 			if($sorted[$i] != $i) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2451: 				carp "Position sequence has gaps (positions: @sorted)";
 2452: 				last;
 2453: 			}
 2454: 		}
 2455: 	}
 2456: }
 2457: 
 2458: # --------------------------------------------------
 2459: # _validate_input_semantics
 2460: #
 2461: # Purpose:    Validate semantic type annotations and
 2462: #             enum/memberof constraints on input params.
 2463: #
 2464: # Entry:      $schema - the full parsed schema hashref.
 2465: #             $schema->{input} must be a hashref.
 2466: #
 2467: # Exit:       Returns nothing. Croaks on conflicting
 2468: #             or malformed enum/memberof. Carps on
 2469: #             unknown semantic types.
 2470: # Side effects: None.
 2471: # --------------------------------------------------
 2472: sub _validate_input_semantics {
●2473 → 2477 → 0 2473: 	my $schema = $_[0];
 2474: 
 2475: 	my $semantic_generators = _get_semantic_generators();
 2476: 
 2477: 	for my $param (keys %{$schema->{input}}) {
 2478: 		my $spec = $schema->{input}{$param};
 2479: 		next unless ref($spec) eq 'HASH';
 2480: 
 2481: 		# Warn on unknown semantic types rather than croaking —
 2482: 		# new semantic types may be added without updating this list
 2483: 		if(defined($spec->{semantic})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2484: 			my $semantic = $spec->{semantic};
 2485: 			unless(exists $semantic_generators->{$semantic}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2486: 				carp "Unknown semantic type '$semantic' for parameter '$param'. " .
 2487: 					'Available types: ' .
 2488: 					join(', ', sort keys %{$semantic_generators});
 2489: 			}
 2490: 		}
 2491: 
 2492: 		# enum and memberof are mutually exclusive representations
 2493: 		# of the same concept — having both is always a schema error
 2494: 		if($spec->{'enum'} && $spec->{'memberof'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2495: 			croak "$param: has both enum and memberof";
 2496: 		}
 2497: 
 2498: 		# Both enum and memberof must be arrayrefs when present
 2499: 		for my $type ('enum', 'memberof') {
 2500: 			if(exists $spec->{$type}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2501: 				croak "$type must be an arrayref"
 2502: 					unless ref($spec->{$type}) eq 'ARRAY';
 2503: 			}
 2504: 		}
 2505: 	}
 2506: }
 2507: 
 2508: # --------------------------------------------------
 2509: # _validate_transform_properties
 2510: #
 2511: # Purpose:    Validate the properties array in each
 2512: #             transform definition, checking that each
 2513: #             property is either a known builtin name
 2514: #             or a custom hashref with name and code.
 2515: #
 2516: # Entry:      $schema - the full parsed schema hashref.
 2517: #             $schema->{transforms} must be a hashref.
 2518: #
 2519: # Exit:       Returns nothing. Croaks on invalid property
 2520: #             definitions. Carps on unknown builtins.
 2521: # Side effects: None.
 2522: # --------------------------------------------------
 2523: sub _validate_transform_properties {
●2524 → 2528 → 0 2524: 	my $schema = $_[0];
 2525: 
 2526: 	my $builtin_props = _get_builtin_properties();
 2527: 
 2528: 	for my $transform_name (keys %{$schema->{transforms}}) {
 2529: 		my $transform = $schema->{transforms}{$transform_name};
 2530: 
 2531: 		# properties is optional — skip transforms that don't define it
 2532: 		next unless exists $transform->{properties};
 2533: 
 2534: 		croak "Transform '$transform_name': properties must be an array"
 2535: 			unless ref($transform->{properties}) eq 'ARRAY';
 2536: 
 2537: 		for my $prop (@{$transform->{properties}}) {
 2538: 			if(!ref($prop)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2539: 				# Plain string — must be a known builtin property name
 2540: 				unless(exists $builtin_props->{$prop}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2541: 					carp "Transform '$transform_name': unknown built-in property '$prop'. " .
 2542: 						'Available: ' .
 2543: 						join(', ', sort keys %{$builtin_props});
 2544: 				}
 2545: 			} elsif(ref($prop) eq 'HASH') {
 2546: 				# Custom property — must have both name and code fields
 2547: 				unless($prop->{name} && $prop->{code}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2548: 					croak "Transform '$transform_name': " .
 2549: 						"custom properties must have 'name' and 'code' fields";
 2550: 				}
 2551: 			} else {
 2552: 				croak "Transform '$transform_name': invalid property definition";
 2553: 			}
 2554: 		}
 2555: 	}
 2556: }
 2557: 
 2558: # --------------------------------------------------
 2559: # _normalize_config
 2560: #
 2561: # Purpose:    Normalise boolean string values in the
 2562: #             config sub-hash to Perl integers (1/0),
 2563: #             and default absent boolean fields to 1
 2564: #             (enabled). The 'properties' field is a
 2565: #             hashref not a boolean and is handled
 2566: #             separately.
 2567: #
 2568: # Entry:      $config - the config sub-hash extracted
 2569: #             from the schema (i.e. $schema->{config}).
 2570: #             May be empty.
 2571: #
 2572: # Exit:       Returns nothing. Modifies $config in place.
 2573: #
 2574: # Side effects: Modifies the caller's config hashref.
 2575: #
 2576: # Notes:      String-to-boolean conversion is delegated
 2577: #             to %Readonly::Values::Boolean::booleans
 2578: #             which handles 'yes'/'no', 'on'/'off',
 2579: #             'true'/'false' etc. Fields not present in
 2580: #             the config hash are defaulted to 1 so
 2581: #             that test generation is maximally thorough
 2582: #             unless the schema explicitly disables a
 2583: #             feature.
 2584: # --------------------------------------------------
 2585: sub _normalize_config {
●2586 → 2588 → 2609●2586 → 2588 → 0 2586: 	my $config = $_[0];
 2587: 
 2588: 	for my $field (CONFIG_TYPES) {
 2589: 		# The properties field is a hashref not a boolean —
 2590: 		# it is handled at the end of this function separately
 2591: 		next if $field eq $CONFIG_PROPERTIES_KEY;
 2592: 
 2593: 		if(exists($config->{$field}) && defined($config->{$field})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2594: 			# Convert string boolean representations to integers
 2595: 			# using the lookup table from Readonly::Values::Boolean
 2596: 			if(defined(my $b = $Readonly::Values::Boolean::booleans{$config->{$field}})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2597: 				$config->{$field} = $b;
 2598: 			}
 2599: 		} else {
 2600: 			# Default absent boolean fields to enabled (1) so that
 2601: 			# test generation is comprehensive unless explicitly disabled
 2602: 			$config->{$field} = 1;
 2603: 		}
 2604: 	}
 2605: 
 2606: 	# Ensure properties is always a hashref — if absent or set to
 2607: 	# a non-hash value, replace with a disabled default so that
 2608: 	# downstream code can safely dereference it without checking ref()
●2609 → 2609 → 0 2609: 	$config->{$CONFIG_PROPERTIES_KEY} = { enable => 0 } unless ref($config->{$CONFIG_PROPERTIES_KEY}) eq 'HASH';
 2610: }
 2611: 
 2612: # --------------------------------------------------
 2613: # _valid_type
 2614: #
 2615: # Determine whether a string is a
 2616: #     recognised schema field type accepted
 2617: #     by the generator.
 2618: #
 2619: # Entry:      $type - the type string to validate.
 2620: #             May be undef.
 2621: #
 2622: # Exit:       Returns 1 if the type is known,
 2623: #             0 if the type is unknown or undef.
 2624: #
 2625: # Side effects: None.
 2626: #
 2627: # Notes:      The lookup hash is declared with
 2628: #             'state' so it is built only once per
 2629: #             process rather than on every call —
 2630: #             important since _valid_type is called
 2631: #             in a loop over all input parameters.
 2632: #
 2633: #             'int' and 'bool' are accepted as
 2634: #             aliases for 'integer' and 'boolean'
 2635: #             respectively, for compatibility with
 2636: #             schemas generated by external tools
 2637: #             that use the shorter forms.
 2638: # --------------------------------------------------
 2639: sub _valid_type {
 2640: 	my $type = $_[0];
 2641: 
 2642: 	# Undef is never a valid type
 2643: 	return 0 unless defined($type);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2644: 
 2645: 	# Build the lookup table once and cache it for
 2646: 	# the lifetime of the process via 'state'
 2647: 	state %VALID = map { $_ => 1 } qw(
 2648: 		string boolean integer number float
 2649: 		hashref arrayref object int bool
 2650: 	);
 2651: 
 2652: 	return($VALID{$type} // 0);
 2653: }
 2654: 
 2655: # --------------------------------------------------
 2656: # _validate_module
 2657: #
 2658: # Purpose:    Check whether the module named in a
 2659: #             schema can be found in @INC during
 2660: #             test generation. Optionally also
 2661: #             attempts to load it if the
 2662: #             GENERATOR_VALIDATE_LOAD environment
 2663: #             variable is set.
 2664: #
 2665: # Entry:      $module      - the module name to
 2666: #                            check. If undef or
 2667: #                            empty, returns 1
 2668: #                            immediately (builtin
 2669: #                            functions need no
 2670: #                            module).
 2671: #             $schema_file - path to the schema
 2672: #                            file, used in warning
 2673: #                            messages only.
 2674: #
 2675: # Exit:       Returns 1 if the module was found
 2676: #             (and loaded, if validation was
 2677: #             requested).
 2678: #             Returns 0 if the module was not
 2679: #             found or failed to load — this is
 2680: #             non-fatal; generation continues.
 2681: #             Returns 1 immediately for undef or
 2682: #             empty $module.
 2683: #
 2684: # Side effects: Prints to STDERR when TEST_VERBOSE
 2685: #               or GENERATOR_VERBOSE is set.
 2686: #               Carps (non-fatally) when the module
 2687: #               cannot be found or loaded.
 2688: #               May attempt to load the module into
 2689: #               the current process when
 2690: #               GENERATOR_VALIDATE_LOAD is set —
 2691: #               this can have side effects depending
 2692: #               on the module.
 2693: #
 2694: # Notes:      Not finding a module during generation
 2695: #             is intentionally non-fatal — the module
 2696: #             may be available on the target machine
 2697: #             even if not on the generation machine.
 2698: #             Verbose output goes to STDERR via
 2699: #             print rather than carp since it is
 2700: #             informational, not a warning.
 2701: # --------------------------------------------------
 2702: sub _validate_module {
●2703 → 2711 → 2724●2703 → 2711 → 0 2703: 	my ($module, $schema_file) = @_;
 2704: 
 2705: 	# Builtin functions have no module to validate
 2706: 	return 1 unless $module;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2707: 
 2708: 	# Check whether the module is findable in @INC
 2709: 	my $mod_info = check_install(module => $module);
 2710: 
 2711: 	if($schema_file && !$mod_info) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2712: 		# Non-fatal — emit a single consolidated warning so
 2713: 		# the caller sees one message rather than four
 2714: 		carp(
 2715: 			"Module '$module' not found in \@INC during generation.\n" .
 2716: 			"  Config file: $schema_file\n" .
 2717: 			"  This is OK if the module will be available when tests run.\n" .
 2718: 			'  If unexpected, check your module name and installation.'
 2719: 		);
 2720: 		return 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2721: 	}
 2722: 
 2723: 	# Check once and reuse — avoids evaluating two env vars twice
●2724 → 2726 → 2735●2724 → 2726 → 0 2724: 	my $verbose = $ENV{$ENV_TEST_VERBOSE} || $ENV{$ENV_GENERATOR_VERBOSE};
 2725: 
 2726: 	if($verbose) {

					

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

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

 2727: 		print STDERR "Found module '$module' at: $mod_info->{'file'}\n",
 2728: 			'  Version: ', ($mod_info->{'version'} || 'unknown'), "\n";
 2729: 	}
 2730: 
 2731: 	# Optional load validation — disabled by default because
 2732: 	# loading a module can have side effects (e.g. BEGIN blocks,
 2733: 	# database connections, file I/O) that are undesirable
 2734: 	# during generation
●2735 → 2735 → 2752●2735 → 2735 → 0 2735: 	if($ENV{$ENV_VALIDATE_LOAD}) {

					

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

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

 2736: 		my $loaded = can_load(modules => { $module => undef }, verbose => 0);
 2737: 
 2738: 		if(!$loaded) {

					

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

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

 2739: 			my $err = $Module::Load::Conditional::ERROR || 'unknown error';
 2740: 			carp(
 2741: 				"Module '$module' found but failed to load: $err\n" .
 2742: 				'  This might indicate a broken installation or missing dependencies.'
 2743: 			);
 2744: 			return 0;

					

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

				
BOOL_NEGATE_2744_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_2744_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' );

								
							
 2745: 		}
 2746: 
 2747: 		if($verbose) {

					

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

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

 2748: 			print STDERR "Successfully loaded module '$module'\n";
 2749: 		}
 2750: 	}
 2751: 
●2752 → 2752 → 0 2752: 	return 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2753: }
 2754: 
 2755: =head2 render_fallback
 2756: 
 2757: Render any Perl value into a compact Perl source-code string using
 2758: L<Data::Dumper>. Used as a catch-all when no more specific renderer
 2759: applies.
 2760: 
 2761:     my $code = render_fallback({ key => 'value' });
 2762:     # returns: "{'key' => 'value'}"
 2763: 
 2764: =head3 Arguments
 2765: 
 2766: =over 4
 2767: 
 2768: =item * C<$v>
 2769: 
 2770: Any Perl value, including undef, scalars, refs, and blessed objects.
 2771: 
 2772: =back
 2773: 
 2774: =head3 Returns
 2775: 
 2776: A string of Perl source code that reproduces the value when evaluated.
 2777: Returns the string C<'undef'> when C<$v> is undef.
 2778: 
 2779: =head3 Side effects
 2780: 
 2781: Temporarily sets C<$Data::Dumper::Terse> and C<$Data::Dumper::Indent>
 2782: to produce compact single-line output. Both are restored on return via
 2783: C<local>.
 2784: 
 2785: =head3 Notes
 2786: 
 2787: The output is always a single line with no trailing newline. Suitable
 2788: for embedding in generated test code where readability is secondary to
 2789: correctness.
 2790: 
 2791: =head3 API specification
 2792: 
 2793: =head4 input
 2794: 
 2795:     { v => { type => SCALAR|REF, optional => 1 } }
 2796: 
 2797: =head4 output
 2798: 
 2799:     { type => SCALAR }
 2800: 
 2801: =cut
 2802: 
 2803: sub render_fallback {
 2804: 	my $v = $_[0];
 2805: 
 2806: 	# Handle undef explicitly rather than letting Dumper produce
 2807: 	# 'undef' without the localised settings applied
 2808: 	return 'undef' unless defined $v;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2809: 
 2810: 	# Use Terse+Indent=0 to produce compact single-line output
 2811: 	# suitable for embedding in generated test code
 2812: 	local $Data::Dumper::Terse  = 1;
 2813: 	local $Data::Dumper::Indent = 0;
 2814: 
 2815: 	my $s = Dumper($v);
 2816: 
 2817: 	# Remove trailing newline that Dumper always appends
 2818: 	chomp $s;
 2819: 	return $s;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2820: }
 2821: 
 2822: =head2 render_hash
 2823: 
 2824: Render a two-level hashref (parameter name => spec hashref) into Perl
 2825: source code suitable for embedding in a generated test file as the
 2826: input specification passed to L<Params::Validate::Strict>.
 2827: 
 2828:     my $code = render_hash(\%input);
 2829: 
 2830: =head3 Arguments
 2831: 
 2832: =over 4
 2833: 
 2834: =item * C<$href>
 2835: 
 2836: A hashref whose values are themselves hashrefs containing field
 2837: specifications. Keys whose values are not hashrefs are skipped with
 2838: a warning.
 2839: 
 2840: =back
 2841: 
 2842: =head3 Returns
 2843: 
 2844: A string of comma-separated Perl source-code lines, one per key, of
 2845: the form:
 2846: 
 2847:     'key' => { subkey => value, ... }
 2848: 
 2849: Returns an empty string if C<$href> is undef, empty, or not a hashref.
 2850: 
 2851: =head3 Side effects
 2852: 
 2853: None. Does not modify C<$href>.
 2854: 
 2855: =head3 Notes
 2856: 
 2857: The C<matches> and C<nomatch> sub-keys are treated specially — their
 2858: values are compiled to C<Regexp> objects via C<eval { qr/.../ }> and
 2859: then rendered using C<perl_quote> so they appear as C<qr{...}> in the
 2860: generated test. This prevents unmatched bracket characters in the
 2861: pattern from causing compilation failures.
 2862: 
 2863: Other sub-keys are rendered via C<perl_quote>.
 2864: 
 2865: =head3 API specification
 2866: 
 2867: =head4 input
 2868: 
 2869:     { href => { type => HASHREF, optional => 1 } }
 2870: 
 2871: =head4 output
 2872: 
 2873:     { type => SCALAR }
 2874: 
 2875: =cut
 2876: 
 2877: sub render_hash {
●2878 → 2886 → 2944●2878 → 2886 → 0 2878: 	my $href = $_[0];
 2879: 
 2880: 	# Return empty string for absent or non-hash input — callers
 2881: 	# treat '' as "no input specification" in the generated test
 2882: 	return '' unless $href && ref($href) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2883: 
 2884: 	my @lines;
 2885: 
 2886: 	for my $k (sort keys %{$href}) {
 2887: 		my $def = $href->{$k};
 2888: 
 2889: 		# Handle scalar shorthand — 'arg1: string' is equivalent to
 2890: 		# 'arg1: { type: string }' and is explicitly supported by the
 2891: 		# validation layer in _validate_input_params
 2892: 		unless(defined($def) && ref($def) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2893: 			if(defined($def) && !ref($def) && _valid_type($def)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2894: 				# Expand scalar type shorthand to a full spec hashref
 2895: 				$def = { type => $def };
 2896: 			} else {
 2897: 				carp "render_hash: skipping key '$k' — value is not a hashref or recognised type string";
 2898: 				next;
 2899: 			}
 2900: 		}
 2901: 
 2902: 		my @pairs;
 2903: 
 2904: 		for my $subk (sort keys %{$def}) {
 2905: 			# Skip undef sub-values — they contribute nothing to the spec
 2906: 			next unless defined $def->{$subk};
 2907: 
 2908: 			# Validate that reference types are ones we can render —
 2909: 			# nested hashrefs are not yet supported
 2910: 			if(ref($def->{$subk})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2911: 				unless((ref($def->{$subk}) eq 'ARRAY') ||

					

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

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

 2912: 				       (ref($def->{$subk}) eq 'Regexp')) {
 2913: 					croak(
 2914: 						__PACKAGE__,
 2915: 						": $subk is a nested element, not yet supported (",
 2916: 						ref($def->{$subk}), ')'
 2917: 					);
 2918: 				}
 2919: 			}
 2920: 
 2921: 			# matches and nomatch values must be Regexp objects in the
 2922: 			# generated test — compile raw strings safely via eval so
 2923: 			# patterns containing [ or \ don't cause compile failures
 2924: 			if(($subk eq $KEY_MATCHES) || ($subk eq $KEY_NOMATCH)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2925: 				my $re = ref($def->{$subk}) eq 'Regexp'
 2926: 					? $def->{$subk}
 2927: 					: eval { qr/$def->{$subk}/ };
 2928: 				if($@ || !defined($re)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2929: 					carp "render_hash: invalid $subk pattern '$def->{$subk}': $@";
 2930: 					next;
 2931: 				}
 2932: 				push @pairs, "$subk => " . perl_quote($re);
 2933: 			} else {
 2934: 				# All other sub-keys are rendered via perl_quote which
 2935: 				# handles scalars, arrayrefs, and Regexp objects correctly
 2936: 				push @pairs, "$subk => " . perl_quote($def->{$subk});
 2937: 			}
 2938: 		}
 2939: 
 2940: 		# Use "\t" rather than a literal tab for clarity and grep-ability
 2941: 		push @lines, "\t" . perl_quote($k) . ' => { ' . join(', ', @pairs) . ' }';
 2942: 	}
 2943: 
●2944 → 2944 → 0 2944: 	return join(",\n", @lines);
 2945: }
 2946: 
 2947: =head2 render_args_hash
 2948: 
 2949: Render a flat hashref into a Perl source-code argument list of the
 2950: form C<'key' => value, ...>, suitable for embedding in a function call
 2951: in a generated test file.
 2952: 
 2953:     my $code = render_args_hash({ type => 'string', min => 1 });
 2954:     # returns: "'min' => 1, 'type' => 'string'"
 2955: 
 2956: =head3 Arguments
 2957: 
 2958: =over 4
 2959: 
 2960: =item * C<$href>
 2961: 
 2962: A flat hashref of key-value pairs. Values may be scalars, arrayrefs,
 2963: or Regexp objects — all are handled by C<perl_quote>.
 2964: 
 2965: =back
 2966: 
 2967: =head3 Returns
 2968: 
 2969: A comma-separated string of C<key => value> pairs sorted by key.
 2970: Returns an empty string if C<$href> is undef, empty, or not a hashref.
 2971: 
 2972: =head3 Side effects
 2973: 
 2974: None.
 2975: 
 2976: =head3 Notes
 2977: 
 2978: Keys and values are both rendered via C<perl_quote>. In particular,
 2979: C<Regexp> values are rendered as C<qr{...}> which is correct for
 2980: L<Params::Validate::Strict> and L<Return::Set> schema arguments in
 2981: the generated test.
 2982: 
 2983: =head3 API specification
 2984: 
 2985: =head4 input
 2986: 
 2987:     { href => { type => HASHREF, optional => 1 } }
 2988: 
 2989: =head4 output
 2990: 
 2991:     { type => SCALAR }
 2992: 
 2993: =cut
 2994: 
 2995: sub render_args_hash {
 2996: 	my $href = $_[0];
 2997: 
 2998: 	# Return empty string for absent or non-hash input
 2999: 	return '' unless $href && ref($href) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3000: 
 3001: 	# Sort keys for deterministic output across runs — important for
 3002: 	# generated test files that are committed to version control
 3003: 	my @pairs = map {
 3004: 		perl_quote($_) . ' => ' . perl_quote($href->{$_})
 3005: 	} sort keys %{$href};
 3006: 
 3007: 	return join(', ', @pairs);
 3008: }
 3009: 
 3010: =head2 render_arrayref_map
 3011: 
 3012: Render a hashref whose values are arrayrefs into a Perl source-code
 3013: fragment suitable for use as a hash literal in a generated test file.
 3014: 
 3015:     my $code = render_arrayref_map({ name => ['', 'a' x 100] });
 3016: 
 3017: =head3 Arguments
 3018: 
 3019: =over 4
 3020: 
 3021: =item * C<$href>
 3022: 
 3023: A hashref whose values are arrayrefs. Keys whose values are not
 3024: arrayrefs are silently skipped.
 3025: 
 3026: =back
 3027: 
 3028: =head3 Returns
 3029: 
 3030: A comma-separated string of C<'key' => [ val, ... ]> entries, one per
 3031: qualifying key, sorted alphabetically. Returns the string C<'()'> if
 3032: C<$href> is undef, empty, or not a hashref — this produces an empty
 3033: hash assignment in the generated test rather than a syntax error.
 3034: 
 3035: =head3 Side effects
 3036: 
 3037: None.
 3038: 
 3039: =head3 Notes
 3040: 
 3041: Array element values are rendered via C<perl_quote> which handles
 3042: scalars, arrayrefs, and Regexp objects. Non-arrayref values are
 3043: skipped without warning — this is intentional since callers may pass
 3044: mixed-value hashes and only want the arrayref entries rendered.
 3045: 
 3046: =head3 API specification
 3047: 
 3048: =head4 input
 3049: 
 3050:     { href => { type => HASHREF, optional => 1 } }
 3051: 
 3052: =head4 output
 3053: 
 3054:     { type => SCALAR }
 3055: 
 3056: =cut
 3057: 
 3058: sub render_arrayref_map {
●3059 → 3067 → 3081●3059 → 3067 → 0 3059: 	my $href = $_[0];
 3060: 
 3061: 	# Return '()' rather than '' so callers get a valid empty hash
 3062: 	# literal rather than a syntax error in the generated test
 3063: 	return '()' unless $href && ref($href) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3064: 
 3065: 	my @entries;
 3066: 
 3067: 	for my $k (sort keys %{$href}) {
 3068: 		my $aref = $href->{$k};
 3069: 
 3070: 		# Skip non-arrayref values — mixed hashes are allowed by callers
 3071: 		next unless ref($aref) eq 'ARRAY';
 3072: 
 3073: 		# Render each array element via perl_quote so strings are
 3074: 		# properly quoted and numbers are left unquoted
 3075: 		my $vals = join(', ', map { perl_quote($_) } @{$aref});
 3076: 
 3077: 		# Use "\t" rather than a literal tab for clarity
 3078: 		push @entries, "\t" . perl_quote($k) . " => [ $vals ]";
 3079: 	}
 3080: 
●3081 → 3081 → 0 3081: 	return join(",\n", @entries);
 3082: }
 3083: 
 3084: # --------------------------------------------------
 3085: # _has_positions
 3086: #
 3087: # Purpose:    Determine whether any field in an input
 3088: #             spec hashref declares a positional argument
 3089: #             via the 'position' key.
 3090: #
 3091: # Entry:      $input_spec - the input section of a parsed
 3092: #             schema, expected to be a hashref whose values
 3093: #             are themselves hashrefs containing field specs.
 3094: #             May be undef or a non-hash ref.
 3095: #
 3096: # Exit:       Returns 1 if any field has a defined
 3097: #             'position' key, 0 otherwise.
 3098: #
 3099: # Side effects: None.
 3100: #
 3101: # Notes:      Returns 0 immediately for undef or non-hash
 3102: #             input rather than throwing — callers use the
 3103: #             return value as a boolean and do not expect
 3104: #             exceptions from this function.
 3105: # --------------------------------------------------
 3106: sub _has_positions {
●3107 → 3112 → 3122●3107 → 3112 → 0 3107: 	my $input_spec = $_[0];
 3108: 
 3109: 	# Guard against undef or non-hash input — keys %$undef would throw
 3110: 	return 0 unless defined($input_spec) && ref($input_spec) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3111: 
 3112: 	for my $field (keys %{$input_spec}) {
 3113: 		# Only examine fields whose spec is a hashref — scalar specs
 3114: 		# (e.g. input: { type: string }) cannot have positions
 3115: 		next unless ref($input_spec->{$field}) eq 'HASH';
 3116: 
 3117: 		# Return immediately on first match — no need to scan further
 3118: 		return 1 if defined $input_spec->{$field}{position};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3119: 	}
 3120: 
 3121: 	# No positional arguments found in any field
●3122 → 3122 → 0 3122: 	return 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3123: }
 3124: 
 3125: # --------------------------------------------------
 3126: # q_wrap
 3127: #
 3128: # Purpose:    Wrap a string in the most readable
 3129: #             q{} form that does not require escaping,
 3130: #             falling back to single-quoted form with
 3131: #             escaped apostrophes if no delimiter is
 3132: #             available.
 3133: #
 3134: # Entry:      $s - the string to wrap. May be undef.
 3135: # Exit:       Returns a Perl source-code fragment that
 3136: #             evaluates to the original string value,
 3137: #             or the string 'undef' if $s is undef.
 3138: #
 3139: # Side effects: None.
 3140: #
 3141: # Notes:      index() returns -1 when not found and
 3142: #             any value >= 0 when found, including 0
 3143: #             for a delimiter at the start of the
 3144: #             string. We compare against $INDEX_NOT_FOUND
 3145: #             to make this boundary explicit and to
 3146: #             prevent off-by-one mutation survivors.
 3147: #             See GitHub issue #1.
 3148: # --------------------------------------------------
 3149: sub q_wrap {
●3150 → 3162 → 3171●3150 → 3162 → 0 3150: 	my $s = $_[0];
 3151: 
 3152: 	# Return empty string for undef — this function is a low-level
 3153: 	# string quoter only. Callers that need the Perl literal 'undef'
 3154: 	# for undefined values should use perl_quote() instead, which
 3155: 	# handles the undef -> 'undef' semantic conversion correctly.
 3156: 	# Returning '' here preserves the original behaviour and avoids
 3157: 	# injecting the bare word 'undef' into contexts that expect a
 3158: 	# quoted string value.
 3159: 	return "''" unless defined $s;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3160: 
 3161: 	# Try bracket-form q{} delimiters first — most readable
 3162: 	for my $p (@Q_BRACKET_PAIRS) {
 3163: 		my ($l, $r) = @{$p};
 3164: 
 3165: 		# Only use this bracket pair if neither bracket
 3166: 		# appears in the string — both must be checked
 3167: 		return "q$l$s$r" unless $s =~ /\Q$l\E|\Q$r\E/;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3168: 	}
 3169: 
 3170: 	# Try single-character delimiters in preference order
●3171 → 3171 → 3176●3171 → 3171 → 0 3171: 	for my $d (@Q_SINGLE_DELIMITERS) {
 3172: 		# index() returns $INDEX_NOT_FOUND (-1) when not found.
 3173: 		# Must use != $INDEX_NOT_FOUND rather than > 0 since
 3174: 		# the delimiter may legitimately appear at position 0
 3175: 		return "q$d$s$d" if index($s, $d) == $INDEX_NOT_FOUND;
  Mutants (Total: 3, Killed: 3, Survived: 0)
●3176 → 3180 → 0 3176: 	}
 3177: 
 3178: 	# Last resort — single-quoted string with escaped apostrophes
 3179: 	(my $esc = $s) =~ s/'/\\'/g;
 3180: 	return "'$esc'";

					

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

				
BOOL_NEGATE_3180_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_3180_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' );

								
							
 3181: }
 3182: 
 3183: # --------------------------------------------------
 3184: # perl_sq
 3185: #
 3186: # Purpose:    Escape a string for safe inclusion
 3187: #             inside a single-quoted Perl string
 3188: #             literal in generated test code.
 3189: #
 3190: # Entry:      $s - the string to escape.
 3191: # Exit:       Returns the escaped string, or an
 3192: #             empty string if $s is undef.
 3193: #
 3194: # Side effects: None.
 3195: #
 3196: # Notes:      NUL byte replacement produces the
 3197: #             two-character sequence \0 which is
 3198: #             only correct when the result is used
 3199: #             inside a double-quoted string context
 3200: #             in the generated test.
 3201: #
 3202: #             The \b substitution (backspace) is
 3203: #             intentionally omitted — in Perl regex
 3204: #             context \b means word boundary, not
 3205: #             backspace, so substituting it here
 3206: #             would corrupt strings containing word
 3207: #             boundaries.
 3208: # --------------------------------------------------
 3209: sub perl_sq {
 3210: 	my $s = $_[0];
 3211: 
 3212: 	# Return empty string for undef — callers that need
 3213: 	# 'undef' literal should use perl_quote instead
 3214: 	return '' unless defined $s;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3215: 
 3216: 	# Escape backslashes first so later substitutions
 3217: 	# don't double-escape already-escaped sequences
 3218: 	$s =~ s/\\/\\\\/g;
 3219: 
 3220: 	# Escape apostrophes so they don't terminate the
 3221: 	# surrounding single-quoted string literal
 3222: 	$s =~ s/'/\\'/g;
 3223: 
 3224: 	# Escape common control characters to their
 3225: 	# printable two-character escape sequences
 3226: 	$s =~ s/\n/\\n/g;
 3227: 	$s =~ s/\r/\\r/g;
 3228: 	$s =~ s/\t/\\t/g;
 3229: 	$s =~ s/\f/\\f/g;
 3230: 
 3231: 	# Replace NUL bytes with \0 — valid only in
 3232: 	# double-quoted string context in generated code
 3233: 	$s =~ s/\0/\\0/g;
 3234: 
 3235: 	return $s;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3236: }
 3237: 
 3238: # --------------------------------------------------
 3239: # perl_quote
 3240: #
 3241: # Purpose:    Convert a Perl value into a source-code
 3242: #             fragment that reproduces that value when
 3243: #             evaluated in a generated test file.
 3244: #
 3245: # Entry:      $v - the value to quote. May be undef,
 3246: #             a scalar, an arrayref, a Regexp, or any
 3247: #             other reference type.
 3248: #
 3249: # Exit:       Returns a string of Perl source code.
 3250: #             Undef produces the literal 'undef'.
 3251: #             Numbers are returned unquoted.
 3252: #             Strings are returned single-quoted via
 3253: #             perl_sq(). Arrays are recursively quoted.
 3254: #             Regexps are rendered as qr{...}.
 3255: #             Other refs fall through to render_fallback.
 3256: #
 3257: # Side effects: None.
 3258: #
 3259: # Notes:      The boolean string literals 'true' and
 3260: #             'false' are converted to Perl boolean
 3261: #             constants !!1 and !!0 respectively so
 3262: #             that YAML boolean values round-trip
 3263: #             correctly into generated tests.
 3264: # --------------------------------------------------
 3265: sub perl_quote {
●3266 → 3276 → 3300●3266 → 3276 → 0 3266: 	my $v = $_[0];
 3267: 
 3268: 	# Undef produces the Perl literal 'undef'
 3269: 	return 'undef' unless defined $v;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3270: 
 3271: 	# Convert YAML boolean string literals to Perl
 3272: 	# boolean constants so they survive round-tripping
 3273: 	return '!!1' if $v eq 'true';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3274: 	return '!!0' if $v eq 'false';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3275: 
 3276: 	if(ref($v)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3277: 		# Recursively quote each element of an arrayref
 3278: 		if(ref($v) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3279: 			my @quoted_v = map { perl_quote($_) } @{$v};
 3280: 			return '[ ' . join(', ', @quoted_v) . ' ]';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3281: 		}
 3282: 
 3283: 		# Render Regexp objects as qr{} with modifiers
 3284: 		if(ref($v) eq 'Regexp') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3285: 			my ($pat, $mods) = regexp_pattern($v);
 3286: 			my $re = "qr{$pat}";
 3287: 
 3288: 			# Append modifiers (e.g. 'i', 'x') if present
 3289: 			$re .= $mods if $mods;
 3290: 			return $re;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3291: 		}
 3292: 
 3293: 		# Hashrefs and other reference types fall through
 3294: 		# to render_fallback which uses Data::Dumper
 3295: 		return render_fallback($v);
 3296: 	}
 3297: 
 3298: 	# Numeric values are emitted unquoted so the generated
 3299: 	# test performs numeric rather than string comparison
●3300 → 3300 → 0 3300: 	return looks_like_number($v) ? $v : "'" . perl_sq($v) . "'";
 3301: }
 3302: 
 3303: # --------------------------------------------------
 3304: # _generate_transform_properties
 3305: #
 3306: # Convert a hashref of transform
 3307: #     specifications into an arrayref of
 3308: #     LectroTest property definition hashrefs,
 3309: #     one per transform. Each hashref contains
 3310: #     all the information needed by
 3311: #     _render_properties to emit a runnable
 3312: #     Test::LectroTest property block.
 3313: #
 3314: # Entry:      $transforms  - hashref of transform name
 3315: #                            => transform spec, as
 3316: #                            loaded from the schema.
 3317: #             $function    - name of the function under
 3318: #                            test.
 3319: #             $module      - module name, or undef for
 3320: #                            builtin functions.
 3321: #             $input       - the top-level input spec
 3322: #                            hashref from the schema
 3323: #                            (used for position sorting).
 3324: #             $config      - the normalised config
 3325: #                            hashref, used to read
 3326: #                            properties.trials.
 3327: #             $new         - defined if the function is
 3328: #                            an object method; the value
 3329: #                            is not used here since
 3330: #                            property tests always
 3331: #                            construct a fresh object
 3332: #                            via new_ok() with no args.
 3333: #                            Presence vs absence is the
 3334: #                            only signal used.
 3335: #
 3336: # Exit:       Returns an arrayref of property hashrefs.
 3337: #             Returns an empty arrayref if no transforms
 3338: #             produce any testable properties.
 3339: #             Never returns undef.
 3340: #
 3341: # Side effects: None. Does not modify any argument.
 3342: #
 3343: # Notes:      Transforms whose input is the string
 3344: #             'undef' or whose input spec is not a
 3345: #             hashref are silently skipped — they
 3346: #             represent error-case transforms that have
 3347: #             no meaningful generator.
 3348: #
 3349: #             The 'WARN' vs 'WARNS' distinction in
 3350: #             _STATUS: the schema convention uses
 3351: #             'WARNS' throughout. This function checks
 3352: #             for 'WARNS' to match that convention.
 3353: # --------------------------------------------------
 3354: sub _generate_transform_properties {
●3355 → 3359 → 3491●3355 → 3359 → 0 3355: 	my ($transforms, $function, $module, $input, $config, $new) = @_;
 3356: 
 3357: 	my @properties;
 3358: 
 3359: 	for my $transform_name (sort keys %{$transforms}) {
 3360: 		my $transform   = $transforms->{$transform_name};
 3361: 
 3362: 		my $input_spec  = $transform->{input};
 3363: 
 3364: 		# Guard: skip transforms with no input or with the
 3365: 		# YAML scalar 'undef' as their input — these have no
 3366: 		# generator and cannot produce meaningful properties
 3367: 		if(!defined($input_spec) ||
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3368: 		   (!ref($input_spec) && $input_spec eq 'undef')) {
 3369: 			next;
 3370: 		}
 3371: 
 3372: 		# Guard: skip transforms whose input is not a hashref —
 3373: 		# must come before the helper calls below so we never
 3374: 		# pass a non-hash to _detect_transform_properties or
 3375: 		# _process_custom_properties
 3376: 		next unless ref($input_spec) eq 'HASH';
 3377: 
 3378: 		# Default output spec to empty hash so _STATUS lookups
 3379: 		# below are always safe regardless of schema content
 3380: 		my $output_spec = $transform->{output} // {};
 3381: 
 3382: 		# Detect automatic properties from the transform spec
 3383: 		# (range constraints, type preservation, definedness)
 3384: 		my @detected_props = _detect_transform_properties(
 3385: 			$transform_name,
 3386: 			$input_spec,
 3387: 			$output_spec
 3388: 		);
 3389: 
 3390: 		# Process any custom properties defined in the schema
 3391: 		my @custom_props = ();
 3392: 		if(exists($transform->{properties}) &&

					

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

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

 3393: 		   ref($transform->{properties}) eq 'ARRAY') {
 3394: 			@custom_props = _process_custom_properties(
 3395: 				$transform->{properties},
 3396: 				$function,
 3397: 				$module,
 3398: 				$input_spec,
 3399: 				$output_spec,
 3400: 				$new
 3401: 			);
 3402: 		}
 3403: 
 3404: 		# Combine auto-detected and custom properties into one list
 3405: 		my @all_props = (@detected_props, @custom_props);
 3406: 
 3407: 		# Skip this transform if no properties were produced —
 3408: 		# nothing useful to render into the generated test
 3409: 		next unless @all_props;
 3410: 
 3411: 		# Build the LectroTest generator specification string,
 3412: 		# one entry per input field that has a generator
 3413: 		my @generators;
 3414: 		my @var_names;
 3415: 
 3416: 		for my $field (sort keys %{$input_spec}) {
 3417: 			my $spec = $input_spec->{$field};
 3418: 
 3419: 			# Skip non-hashref field specs — scalar types
 3420: 			# like 'string' have no generator sub-structure
 3421: 			next unless ref($spec) eq 'HASH';
 3422: 
 3423: 			my $gen = _schema_to_lectrotest_generator($field, $spec);
 3424: 			if(defined($gen) && length($gen)) {

					

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

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

 3425: 				push @generators, $gen;
 3426: 				push @var_names, $field;
 3427: 			}
 3428: 		}
 3429: 
 3430: 		my $gen_spec = join(', ', @generators);
 3431: 
 3432: 		# Build the call expression for the function under test.
 3433: 		# Note: property tests always construct a fresh object
 3434: 		# via new_ok() with no constructor arguments, regardless
 3435: 		# of what $new holds in the caller — the intent here is
 3436: 		# to test the method in isolation, not with specific
 3437: 		# construction state.
 3438: 		my $call_code;
 3439: 		if($module && defined($new)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3440: 			# OO mode — construct a fresh object for each trial
 3441: 			$call_code  = "my \$obj = new_ok('$module');";
 3442: 			$call_code .= "\$obj->$function";
 3443: 		} elsif($module && $module ne $MODULE_BUILTIN) {
 3444: 			# Functional mode with a named module
 3445: 			$call_code = "$module\::$function";
 3446: 		} else {
 3447: 			# Builtin or unqualified function call
 3448: 			$call_code = $function;
 3449: 		}
 3450: 
 3451: 		# Build the argument list, respecting positional order
 3452: 		# if the input spec declares positions
 3453: 		my @args;
 3454: 		if(_has_positions($input_spec)) {

					

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

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

 3455: 			# Sort fields by declared position so the generated
 3456: 			# call passes arguments in the correct order
 3457: 			my @sorted = sort {
 3458: 				$input_spec->{$a}{position} <=>
 3459: 				$input_spec->{$b}{position}
 3460: 			} keys %{$input_spec};
 3461: 			@args = map { "\$$_" } @sorted;
 3462: 		} else {
 3463: 			# No positions — use alphabetical order from @var_names
 3464: 			@args = map { "\$$_" } @var_names;
 3465: 		}
 3466: 
 3467: 		my $args_str = join(', ', @args);
 3468: 
 3469: 		# Concatenate all property check expressions with &&
 3470: 		# so the generated property block passes only when
 3471: 		# every check holds
 3472: 		my @checks = map { $_->{code} } @all_props;
 3473: 		my $property_checks = join(" &&\n\t", @checks);
 3474: 
 3475: 		# Determine expected behaviour from output _STATUS.
 3476: 		# Note: the schema convention uses 'WARNS' not 'WARN'
 3477: 		my $should_die  = ($output_spec->{'_STATUS'} // '') eq 'DIES';
 3478: 		my $should_warn = ($output_spec->{'_STATUS'} // '') eq 'WARNS';
 3479: 
 3480: 		push @properties, {
 3481: 			name             => $transform_name,
 3482: 			generator_spec   => $gen_spec,
 3483: 			call_code        => "$call_code($args_str)",
 3484: 			property_checks  => $property_checks,
 3485: 			should_die       => $should_die,
 3486: 			should_warn      => $should_warn,
 3487: 			trials           => $config->{'properties'}{'trials'} // DEFAULT_PROPERTY_TRIALS,
 3488: 		};
 3489: 	}
 3490: 
●3491 → 3491 → 0 3491: 	return \@properties;
 3492: }
 3493: 
 3494: # --------------------------------------------------
 3495: # _get_semantic_generators
 3496: #
 3497: # Return a hashref of named semantic
 3498: #     generator definitions for use in
 3499: #     LectroTest property-based tests.
 3500: #     Each entry contains a 'code' key
 3501: #     holding a Gen {} block string and a
 3502: #     'description' key for documentation
 3503: #     and validation messages.
 3504: #
 3505: # Entry:      None.
 3506: #
 3507: # Exit:       Returns a hashref keyed by semantic
 3508: #             type name. Each value is a hashref
 3509: #             with 'code' and 'description' keys.
 3510: #
 3511: # Side effects: None.
 3512: #
 3513: # Notes:      The returned hashref is built fresh
 3514: #             on every call — callers that need it
 3515: #             repeatedly should cache the result.
 3516: #             The 'code' strings are multi-line
 3517: #             Gen {} blocks; callers are responsible
 3518: #             for compressing whitespace before
 3519: #             embedding them in generated test files.
 3520: # --------------------------------------------------
 3521: sub _get_semantic_generators {
 3522: 	return {
 3523: 		email => {
 3524: 			code => q{
 3525: 				Gen {
 3526: 					my $len = 5 + int(rand(10));
 3527: 					my @addr;
 3528: 					my @tlds = qw(com org net edu gov io co uk de fr);
 3529: 
 3530: 					for(my $i = 0; $i < $len; $i++) {
 3531: 						push @addr, pack('c', (int(rand 26))+97);
 3532: 					}
 3533: 					push @addr, '@';
 3534: 					$len = 5 + int(rand(10));
 3535: 					for(my $i = 0; $i < $len; $i++) {
 3536: 						push @addr, pack('c', (int(rand 26))+97);
 3537: 					}
 3538: 					push @addr, '.';
 3539: 					$len = rand($#tlds+1);
 3540: 					push @addr, $tlds[$len];
 3541: 					return join('', @addr);
 3542: 				}
 3543: 			},
 3544: 			description => 'Valid email addresses',
 3545: 		},
 3546: 
 3547: 		url => {
 3548: 			code => q{
 3549: 				Gen {
 3550: 					my @schemes = qw(http https);
 3551: 					my @tlds = qw(com org net io);
 3552: 					my $scheme = $schemes[int(rand(@schemes))];
 3553: 					my $domain = join('', map { ('a'..'z')[int(rand(26))] } 1..(5 + int(rand(10))));
 3554: 					my $tld = $tlds[int(rand(@tlds))];
 3555: 					my $path = join('', map { ('a'..'z', '0'..'9', '-', '_')[int(rand(38))] } 1..int(rand(20)));
 3556: 
 3557: 					return "$scheme://$domain.$tld" . ($path ? "/$path" : '');
 3558: 				}
 3559: 			},
 3560: 			description => 'Valid HTTP/HTTPS URLs',
 3561: 		},
 3562: 
 3563: 		uuid => {
 3564: 			code => q{
 3565: 				Gen {
 3566: 					require UUID::Tiny;
 3567: 					UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_V4());
 3568: 				}
 3569: 			},
 3570: 			description => 'Valid UUIDv4 identifiers',
 3571: 		},
 3572: 
 3573: 		phone_us => {
 3574: 			code => q{
 3575: 				Gen {
 3576: 					my $area = 200 + int(rand(800));
 3577: 					my $exchange = 200 + int(rand(800));
 3578: 					my $subscriber = int(rand(10000));
 3579: 					sprintf('%03d-%03d-%04d', $area, $exchange, $subscriber);
 3580: 				}
 3581: 			},
 3582: 			description => 'US phone numbers (XXX-XXX-XXXX format)',
 3583: 		},
 3584: 
 3585: 		phone_e164 => {
 3586: 			code => q{
 3587: 				Gen {
 3588: 					my $country = 1 + int(rand(999));
 3589: 					my $area = 100 + int(rand(900));
 3590: 					my $number = int(rand(10000000));
 3591: 					sprintf('+%d%03d%07d', $country, $area, $number);
 3592: 				}
 3593: 			},
 3594: 			description => 'E.164 international phone numbers',
 3595: 		},
 3596: 
 3597: 		ipv4 => {
 3598: 			code => q{
 3599: 				Gen {
 3600: 					join('.', map { int(rand(256)) } 1..4);
 3601: 				}
 3602: 			},
 3603: 			description => 'IPv4 addresses',
 3604: 		},
 3605: 
 3606: 		ipv6 => {
 3607: 			code => q{
 3608: 				Gen {
 3609: 					join(':', map { sprintf('%04x', int(rand(0x10000))) } 1..8);
 3610: 				}
 3611: 			},
 3612: 			description => 'IPv6 addresses',
 3613: 		},
 3614: 
 3615: 		username => {
 3616: 			code => q{
 3617: 				Gen {
 3618: 					my $len = 3 + int(rand(13));
 3619: 					my @chars = ('a'..'z', '0'..'9', '_', '-');
 3620: 					my $first = ('a'..'z')[int(rand(26))];
 3621: 					$first . join('', map { $chars[int(rand(@chars))] } 1..($len-1));
 3622: 				}
 3623: 			},
 3624: 			description => 'Valid usernames (alphanumeric with _ and -)',
 3625: 		},
 3626: 
 3627: 		slug => {
 3628: 			code => q{
 3629: 				Gen {
 3630: 					my @words = qw(quick brown fox jumps over lazy dog hello world test data);
 3631: 					my $count = 1 + int(rand(4));
 3632: 					join('-', map { $words[int(rand(@words))] } 1..$count);
 3633: 				}
 3634: 			},
 3635: 			description => 'URL slugs (lowercase words separated by hyphens)',
 3636: 		},
 3637: 
 3638: 		hex_color => {
 3639: 			code => q{
 3640: 				Gen {
 3641: 					sprintf('#%06x', int(rand(0x1000000)));
 3642: 				}
 3643: 			},
 3644: 			description => 'Hex color codes (#RRGGBB)',
 3645: 		},
 3646: 
 3647: 		iso_date => {
 3648: 			code => q{
 3649: 				Gen {
 3650: 					my $year = 2000 + int(rand(25));
 3651: 					my $month = 1 + int(rand(12));
 3652: 					my $day = 1 + int(rand(28));
 3653: 					sprintf('%04d-%02d-%02d', $year, $month, $day);
 3654: 				}
 3655: 			},
 3656: 			description => 'ISO 8601 date format (YYYY-MM-DD)',
 3657: 		},
 3658: 
 3659: 		iso_datetime => {
 3660: 			code => q{
 3661: 				Gen {
 3662: 					my $year = 2000 + int(rand(25));
 3663: 					my $month = 1 + int(rand(12));
 3664: 					my $day = 1 + int(rand(28));
 3665: 					my $hour = int(rand(24));
 3666: 					my $minute = int(rand(60));
 3667: 					my $second = int(rand(60));
 3668: 					sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ',
 3669: 						$year, $month, $day, $hour, $minute, $second);
 3670: 				}
 3671: 			},
 3672: 			description => 'ISO 8601 datetime format (YYYY-MM-DDTHH:MM:SSZ)',
 3673: 		},
 3674: 
 3675: 		semver => {
 3676: 			code => q{
 3677: 				Gen {
 3678: 					my $major = int(rand(10));
 3679: 					my $minor = int(rand(20));
 3680: 					my $patch = int(rand(50));
 3681: 					"$major.$minor.$patch";
 3682: 				}
 3683: 			},
 3684: 			description => 'Semantic version strings (major.minor.patch)',
 3685: 		},
 3686: 
 3687: 		jwt => {
 3688: 			code => q{
 3689: 				Gen {
 3690: 					my @chars = ('A'..'Z', 'a'..'z', '0'..'9', '-', '_');
 3691: 					my $header    = join('', map { $chars[int(rand(@chars))] } 1..20);
 3692: 					my $payload   = join('', map { $chars[int(rand(@chars))] } 1..40);
 3693: 					my $signature = join('', map { $chars[int(rand(@chars))] } 1..30);
 3694: 					"$header.$payload.$signature";
 3695: 				}
 3696: 			},
 3697: 			description => 'JWT-like tokens (base64url format)',
 3698: 		},
 3699: 
 3700: 		json => {
 3701: 			code => q{
 3702: 				Gen {
 3703: 					my @keys = qw(id name value status count);
 3704: 					my $key = $keys[int(rand(@keys))];
 3705: 					my $value = 1 + int(rand(1000));
 3706: 					qq({"$key":$value});
 3707: 				}
 3708: 			},
 3709: 			description => 'Simple JSON objects',
 3710: 		},
 3711: 
 3712: 		base64 => {
 3713: 			code => q{
 3714: 				Gen {
 3715: 					my @chars = ('A'..'Z', 'a'..'z', '0'..'9', '+', '/');
 3716: 					my $len = 12 + int(rand(20));
 3717: 					my $str = join('', map { $chars[int(rand(@chars))] } 1..$len);
 3718: 					$str .= '=' x (4 - ($len % 4)) if $len % 4;
 3719: 					$str;
 3720: 				}
 3721: 			},
 3722: 			description => 'Base64-encoded strings',
 3723: 		},
 3724: 
 3725: 		md5 => {
 3726: 			code => q{
 3727: 				Gen {
 3728: 					join('', map { sprintf('%x', int(rand(16))) } 1..32);
 3729: 				}
 3730: 			},
 3731: 			description => 'MD5 hashes (32 hex characters)',
 3732: 		},
 3733: 
 3734: 		sha256 => {
 3735: 			code => q{
 3736: 				Gen {
 3737: 					join('', map { sprintf('%x', int(rand(16))) } 1..64);
 3738: 				}
 3739: 			},
 3740: 			description => 'SHA-256 hashes (64 hex characters)',
 3741: 		},
 3742: 
 3743: 		unix_timestamp => {
 3744: 			code => q{
 3745: 				Gen {
 3746: 					time;
 3747: 				}
 3748: 			},
 3749: 			description => 'Unix timestamps (seconds since epoch)',
 3750: 		},
 3751: 	};
 3752: }
 3753: 
 3754: # --------------------------------------------------
 3755: # _get_builtin_properties
 3756: #
 3757: # Purpose:    Return a hashref of named built-in
 3758: #             property templates that can be
 3759: #             referenced by name in a transform's
 3760: #             'properties' list in the schema.
 3761: #             Each entry contains a 'description'
 3762: #             string, a 'code_template' coderef, and
 3763: #             an 'applicable_to' arrayref.
 3764: #
 3765: # Entry:      None.
 3766: #
 3767: # Exit:       Returns a hashref keyed by property
 3768: #             name. Each value is a hashref with
 3769: #             'description', 'code_template', and
 3770: #             'applicable_to' keys.
 3771: #
 3772: # Side effects: None.
 3773: #
 3774: # Notes:      'applicable_to' lists the types for
 3775: #             which each property is meaningful. It
 3776: #             is stored for documentation purposes
 3777: #             and potential future filtering — it is
 3778: #             not currently enforced by any caller.
 3779: #
 3780: #             Each 'code_template' coderef receives
 3781: #             three arguments: ($function, $call_code,
 3782: #             $input_vars). Most templates use only
 3783: #             $call_code; $function and $input_vars
 3784: #             are provided for templates that need
 3785: #             them (e.g. idempotent, length_preserved,
 3786: #             preserves_keys).
 3787: #
 3788: #             'monotonic_increasing' has been
 3789: #             intentionally omitted. A correct
 3790: #             implementation requires calling the
 3791: #             function twice with ordered inputs,
 3792: #             which the current single-call property
 3793: #             framework does not support. A
 3794: #             placeholder that unconditionally returns
 3795: #             true would give false confidence and has
 3796: #             therefore been removed.
 3797: # --------------------------------------------------
 3798: sub _get_builtin_properties {
 3799: 	return {
 3800: 		idempotent => {
 3801: 			description   => 'Function is idempotent: f(f(x)) == f(x)',
 3802: 			code_template => sub {
 3803: 				my ($function, $call_code, $input_vars) = @_;
 3804: 
 3805: 				# String comparison works for all scalar types in Perl —
 3806: 				# numeric values stringify consistently for eq
 3807: 				return "do { my \$tmp = $call_code; \$result eq \$tmp }";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3808: 			},
 3809: 			applicable_to => ['all'],
 3810: 		},
 3811: 
 3812: 		non_negative => {
 3813: 			description   => 'Result is always non-negative',
 3814: 			code_template => sub {
 3815: 				my ($function, $call_code, $input_vars) = @_;
 3816: 				return '$result >= 0';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3817: 			},
 3818: 			applicable_to => ['number', 'integer', 'float'],
 3819: 		},
 3820: 
 3821: 		positive => {
 3822: 			description   => 'Result is always positive (> 0)',
 3823: 			code_template => sub {
 3824: 				my ($function, $call_code, $input_vars) = @_;
 3825: 				return '$result > 0';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3826: 			},
 3827: 			applicable_to => ['number', 'integer', 'float'],
 3828: 		},
 3829: 
 3830: 		non_empty => {
 3831: 			description   => 'Result is never empty',
 3832: 			code_template => sub {
 3833: 				my ($function, $call_code, $input_vars) = @_;
 3834: 				return 'length($result) > 0';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3835: 			},
 3836: 			applicable_to => ['string'],
 3837: 		},
 3838: 
 3839: 		length_preserved => {
 3840: 			description   => 'Output length equals input length',
 3841: 			code_template => sub {
 3842: 				my ($function, $call_code, $input_vars) = @_;
 3843: 				my $first_var = $input_vars->[0];
 3844: 				return "length(\$result) == length(\$$first_var)";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3845: 			},
 3846: 			applicable_to => ['string'],
 3847: 		},
 3848: 
 3849: 		uppercase => {
 3850: 			description   => 'Result is all uppercase',
 3851: 			code_template => sub {
 3852: 				my ($function, $call_code, $input_vars) = @_;
 3853: 				return '$result eq uc($result)';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3854: 			},
 3855: 			applicable_to => ['string'],
 3856: 		},
 3857: 
 3858: 		lowercase => {
 3859: 			description   => 'Result is all lowercase',
 3860: 			code_template => sub {
 3861: 				my ($function, $call_code, $input_vars) = @_;
 3862: 				return '$result eq lc($result)';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3863: 			},
 3864: 			applicable_to => ['string'],
 3865: 		},
 3866: 
 3867: 		trimmed => {
 3868: 			description   => 'Result has no leading or trailing whitespace',
 3869: 			code_template => sub {
 3870: 				my ($function, $call_code, $input_vars) = @_;
 3871: 				return '$result !~ /^\s/ && $result !~ /\s$/';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3872: 			},
 3873: 			applicable_to => ['string'],
 3874: 		},
 3875: 
 3876: 		sorted_ascending => {
 3877: 			description   => 'Array is sorted in ascending order',
 3878: 			code_template => sub {
 3879: 				my ($function, $call_code, $input_vars) = @_;
 3880: 				return 'do { my @arr = @$result; my $sorted = 1; ' .

					

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

				
BOOL_NEGATE_3880_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_3880_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' );

								
							
 3881: 					'for my $i (1..$#arr) { $sorted = 0 if $arr[$i] < $arr[$i-1]; } ' .
 3882: 					'$sorted }';
 3883: 			},
 3884: 			applicable_to => ['arrayref'],
 3885: 		},
 3886: 
 3887: 		sorted_descending => {
 3888: 			description   => 'Array is sorted in descending order',
 3889: 			code_template => sub {
 3890: 				my ($function, $call_code, $input_vars) = @_;
 3891: 				return 'do { my @arr = @$result; my $sorted = 1; ' .

					

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

				
BOOL_NEGATE_3891_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_3891_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' );

								
							
 3892: 					'for my $i (1..$#arr) { $sorted = 0 if $arr[$i] > $arr[$i-1]; } ' .
 3893: 					'$sorted }';
 3894: 			},
 3895: 			applicable_to => ['arrayref'],
 3896: 		},
 3897: 
 3898: 		unique_elements => {
 3899: 			description   => 'Array has no duplicate elements',
 3900: 			code_template => sub {
 3901: 				my ($function, $call_code, $input_vars) = @_;
 3902: 				return 'do { my @arr = @$result; my %seen; !grep { $seen{$_}++ } @arr }';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3903: 			},
 3904: 			applicable_to => ['arrayref'],
 3905: 		},
 3906: 
 3907: 		preserves_keys => {
 3908: 			description   => 'Hash has same keys as input',
 3909: 			code_template => sub {
 3910: 				my ($function, $call_code, $input_vars) = @_;
 3911: 				my $first_var = $input_vars->[0];
 3912: 				return 'do { my @in  = sort keys %{$' . $first_var . '}; ' .

					

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

				
BOOL_NEGATE_3912_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_3912_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' );

								
							
 3913: 					'my @out = sort keys %$result; ' .
 3914: 					'join(",", @in) eq join(",", @out) }';
 3915: 			},
 3916: 			applicable_to => ['hashref'],
 3917: 		},
 3918: 	};
 3919: }
 3920: 
 3921: # --------------------------------------------------
 3922: # _schema_to_lectrotest_generator
 3923: #
 3924: # Purpose:    Convert a single schema field spec
 3925: #             hashref into a LectroTest generator
 3926: #             declaration string of the form
 3927: #             '$field <- Generator(...)'.
 3928: #             Used to build the ##[ ... ]## generator
 3929: #             block inside a Property definition.
 3930: #
 3931: # Entry:      $field_name - the parameter name as it
 3932: #                           will appear in the
 3933: #                           generated test code.
 3934: #             $spec       - hashref containing at
 3935: #                           minimum a 'type' key.
 3936: #                           May also contain 'min',
 3937: #                           'max', 'semantic', and
 3938: #                           'matches' keys depending
 3939: #                           on type.
 3940: #
 3941: # Exit:       Returns a string of the form
 3942: #             '$field <- Generator(...)' on success.
 3943: #             Returns undef if the spec is not a
 3944: #             hashref or if range constraints are
 3945: #             invalid (min >= max for numeric types).
 3946: #             Returns a String generator with a carp
 3947: #             warning for unknown types.
 3948: #
 3949: # Side effects: Carps on unknown semantic types,
 3950: #               invalid numeric ranges, and unknown
 3951: #               field types.
 3952: #
 3953: # Notes:      Semantic generators are checked first
 3954: #             for string fields and take precedence
 3955: #             over the regular string generator.
 3956: #             The $input_spec parameter in the type-
 3957: #             detection helpers is reserved for future
 3958: #             use and is currently unused.
 3959: # --------------------------------------------------
 3960: sub _schema_to_lectrotest_generator {
●3961 → 3974 → 3998●3961 → 3974 → 0 3961: 	my ($field_name, $spec) = @_;
 3962: 
 3963: 	# Guard: must be a hashref to dereference safely
 3964: 	return unless defined($spec) && ref($spec) eq 'HASH';
 3965: 
 3966: 	# Default to string when no type is declared
 3967: 	my $type = $spec->{'type'} || $DEFAULT_FIELD_TYPE;
 3968: 
 3969: 	# --------------------------------------------------
 3970: 	# Semantic generators take precedence for string
 3971: 	# fields — they produce realistic domain-specific
 3972: 	# values rather than random character sequences
 3973: 	# --------------------------------------------------
 3974: 	if($type eq 'string' && defined($spec->{'semantic'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3975: 		my $semantic_type = $spec->{'semantic'};
 3976: 		my $generators    = _get_semantic_generators();
 3977: 
 3978: 		if(exists($generators->{$semantic_type})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3979: 			my $gen_code = $generators->{$semantic_type}{'code'};
 3980: 
 3981: 			# Compress the multi-line generator code into a
 3982: 			# single line for embedding in the ##[ ]## block
 3983: 			$gen_code =~ s/^\s+//;
 3984: 			$gen_code =~ s/\s+$//;
 3985: 			$gen_code =~ s/\n\s+/ /g;
 3986: 
 3987: 			return "$field_name <- $gen_code";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3988: 		} else {
 3989: 			carp "Unknown semantic type '$semantic_type', " .
 3990: 				"falling back to regular string generator";
 3991: 			# Fall through to regular string generation below
 3992: 		}
 3993: 	}
 3994: 
 3995: 	# --------------------------------------------------
 3996: 	# Integer generator
 3997: 	# --------------------------------------------------
●3998 → 3998 → 4021●3998 → 3998 → 0 3998: 	if($type eq 'integer') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3999: 		my $min = $spec->{'min'};
 4000: 		my $max = $spec->{'max'};
 4001: 
 4002: 		if(!defined($min) && !defined($max)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4003: 			# Unconstrained — use LectroTest's built-in Int
 4004: 			return "$field_name <- Int";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4005: 		} elsif(!defined($min)) {
 4006: 			# Only max defined — generate 0 to max
 4007: 			return "$field_name <- Int(sized => sub { int(rand($max + 1)) })";

					

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

				
BOOL_NEGATE_4007_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_4007_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' );

								
							
 4008: 		} elsif(!defined($max)) {
 4009: 			# Only min defined — generate min to min + range
 4010: 			return "$field_name <- Int(sized => sub { $min + int(rand($DEFAULT_GENERATOR_RANGE)) })";

					

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

				
BOOL_NEGATE_4010_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_4010_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' );

								
							
 4011: 		} else {
 4012: 			# Both defined — generate within [min, max]
 4013: 			my $range = $max - $min;
 4014: 			return "$field_name <- Int(sized => sub { $min + int(rand($range + 1)) })";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4015: 		}
 4016: 	}
 4017: 
 4018: 	# --------------------------------------------------
 4019: 	# Float / number generator
 4020: 	# --------------------------------------------------
●4021 → 4021 → 4071●4021 → 4021 → 0 4021: 	if($type eq 'number' || $type eq 'float') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4022: 		my $min = $spec->{'min'};
 4023: 		my $max = $spec->{'max'};
 4024: 
 4025: 		if(!defined($min) && !defined($max)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4026: 			# Unconstrained — symmetric range around zero
 4027: 			return "$field_name <- Float(sized => sub { rand($DEFAULT_GENERATOR_RANGE) - $DEFAULT_GENERATOR_RANGE / 2 })";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4028: 
 4029: 		} elsif(!defined($min)) {
 4030: 			# Only max defined — choose range based on sign of max
 4031: 			if($max == $ZERO_BOUNDARY) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4032: 				# max=0: negative numbers only
 4033: 				return "$field_name <- Float(sized => sub { -rand($DEFAULT_GENERATOR_RANGE) })";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4034: 			} elsif($max > $ZERO_BOUNDARY) {

					

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

				
NUM_BOUNDARY_4034_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_4034_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_4034_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' );

								
							
 4035: 				# Positive max: generate 0 to max
 4036: 				return "$field_name <- Float(sized => sub { rand($max) })";

					

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

				
BOOL_NEGATE_4036_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_4036_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' );

								
							
 4037: 			} else {
 4038: 				# Negative max: generate from (max - range) to max
 4039: 				return "$field_name <- Float(sized => sub { ($max - $DEFAULT_GENERATOR_RANGE) + rand($DEFAULT_GENERATOR_RANGE + $max) })";

					

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

				
BOOL_NEGATE_4039_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_4039_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' );

								
							
 4040: 			}
 4041: 
 4042: 		} elsif(!defined($max)) {
 4043: 			# Only min defined — choose range based on sign of min
 4044: 			if($min == $ZERO_BOUNDARY) {

					

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

				
NUM_BOUNDARY_4044_12_!=: 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_4044_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4045: 				# min=0: positive numbers only
 4046: 				return "$field_name <- Float(sized => sub { rand($DEFAULT_GENERATOR_RANGE) })";

					

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

				
BOOL_NEGATE_4046_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_4046_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' );

								
							
 4047: 			} elsif($min > $ZERO_BOUNDARY) {

					

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

				
NUM_BOUNDARY_4047_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_4047_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_4047_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' );

								
							
 4048: 				# Positive min: generate min to min + range
 4049: 				return "$field_name <- Float(sized => sub { $min + rand($DEFAULT_GENERATOR_RANGE) })";

					

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

				
BOOL_NEGATE_4049_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_4049_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' );

								
							
 4050: 			} else {
 4051: 				# Negative min: generate from min to min + range
 4052: 				return "$field_name <- Float(sized => sub { $min + rand(-$min + $DEFAULT_GENERATOR_RANGE) })";

					

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

				
BOOL_NEGATE_4052_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_4052_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' );

								
							
 4053: 			}
 4054: 
 4055: 		} else {
 4056: 			# Both min and max defined — validate then generate
 4057: 			my $range = $max - $min;
 4058: 			if($range <= $ZERO_BOUNDARY) {

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_4058_14_<: 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_4058_14_>: 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_4058_14_>=: 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' );

								
							
 4059: 				carp "Invalid range for '$field_name': min=$min, max=$max";
 4060: 				# Return undef rather than emitting a degenerate
 4061: 				# generator that would silently produce wrong values
 4062: 				return;
 4063: 			}
 4064: 			return "$field_name <- Float(sized => sub { $min + rand($range) })";

					

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

				
BOOL_NEGATE_4064_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_4064_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' );

								
							
 4065: 		}
 4066: 	}
 4067: 
 4068: 	# --------------------------------------------------
 4069: 	# String generator
 4070: 	# --------------------------------------------------
●4071 → 4071 → 4095●4071 → 4071 → 0 4071: 	if($type eq 'string') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4072: 		my $min_len = $spec->{'min'} // 0;
 4073: 		my $max_len = $spec->{'max'} // $DEFAULT_MAX_STRING_LEN;
 4074: 
 4075: 		# If a regex pattern is declared, delegate to
 4076: 		# Data::Random::String::Matches for pattern-aware generation
 4077: 		if(defined($spec->{'matches'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4078: 			my $pattern = $spec->{'matches'};
 4079: 
 4080: 			if(defined($spec->{'max'})) {

					

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

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

 4081: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => qr/$pattern/, length => $spec->{'max'} }) }";

					

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

				
BOOL_NEGATE_4081_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_4081_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' );

								
							
 4082: 			} elsif(defined($spec->{'min'})) {
 4083: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => qr/$pattern/, length => $spec->{'min'} }) }";

					

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

				
BOOL_NEGATE_4083_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_4083_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' );

								
							
 4084: 			} else {
 4085: 				return "$field_name <- Gen { Data::Random::String::Matches->create_random_string({ regex => qr/$pattern/ }) }";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4086: 			}
 4087: 		}
 4088: 
 4089: 		return "$field_name <- String(length => [$min_len, $max_len])";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4090: 	}
 4091: 
 4092: 	# --------------------------------------------------
 4093: 	# Boolean generator
 4094: 	# --------------------------------------------------
●4095 → 4095 → 4102●4095 → 4095 → 0 4095: 	if($type eq 'boolean') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4096: 		return "$field_name <- Bool";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4097: 	}
 4098: 
 4099: 	# --------------------------------------------------
 4100: 	# Arrayref generator
 4101: 	# --------------------------------------------------
●4102 → 4102 → 4113●4102 → 4102 → 0 4102: 	if($type eq 'arrayref') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4103: 		my $min_size = $spec->{'min'} // 0;
 4104: 		my $max_size = $spec->{'max'} // $DEFAULT_MAX_COLLECTION_SIZE;
 4105: 		return "$field_name <- List(Int, length => [$min_size, $max_size])";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4106: 	}
 4107: 
 4108: 	# --------------------------------------------------
 4109: 	# Hashref generator
 4110: 	# LectroTest has no built-in Hash generator so we
 4111: 	# use Elements over a pre-built list of hashrefs
 4112: 	# --------------------------------------------------
●4113 → 4113 → 4122●4113 → 4113 → 0 4113: 	if($type eq 'hashref') {

					

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

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

 4114: 		my $min_keys = $spec->{'min'} // 0;
 4115: 		my $max_keys = $spec->{'max'} // $DEFAULT_MAX_COLLECTION_SIZE;
 4116: 		return "$field_name <- Elements(map { my \%h; for (1..\$_) { \$h{'key'.\$_} = \$_ }; \\\%h } $min_keys..$max_keys)";

					

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

				
BOOL_NEGATE_4116_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_4116_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' );

								
							
 4117: 	}
 4118: 
 4119: 	# --------------------------------------------------
 4120: 	# Unknown type — fall back to String with a warning
 4121: 	# --------------------------------------------------
●[NOT COVERED] 4122 → 4123 → 0 4122: 	carp "Unknown type '$type' for '$field_name' LectroTest generator, using String";
 4123: 	return "$field_name <- String";

					

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

				
BOOL_NEGATE_4123_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_4123_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' );

								
							
 4124: }
 4125: 
 4126: # --------------------------------------------------
 4127: # _is_numeric_transform
 4128: #
 4129: # Determine whether a transform's output
 4130: #     spec declares a numeric type, indicating
 4131: #     that numeric range properties should be
 4132: #     generated for it.
 4133: #
 4134: # Entry:      $input_spec  - the transform's input
 4135: #                            spec hashref. Currently
 4136: #                            unused; reserved for
 4137: #                            future input-type checks.
 4138: #             $output_spec - the transform's output
 4139: #                            spec hashref.
 4140: #
 4141: # Exit:       Returns 1 if the output type is one of
 4142: #             'number', 'integer', or 'float'.
 4143: #             Returns 0 otherwise.
 4144: #
 4145: # Side effects: None.
 4146: # --------------------------------------------------
 4147: sub _is_numeric_transform {
 4148: 	my ($input_spec, $output_spec) = @_;
 4149: 
 4150: 	# $input_spec is currently unused — reserved for future
 4151: 	# input-side type checking when detecting mixed transforms
 4152: 	my $out_type = ($output_spec // {})->{'type'} // '';
 4153: 
 4154: 	return($out_type eq 'number' || $out_type eq 'integer' || $out_type eq 'float');
 4155: }
 4156: 
 4157: # --------------------------------------------------
 4158: # _is_string_transform
 4159: #
 4160: # Purpose:    Determine whether a transform's output
 4161: #             spec declares a string type, indicating
 4162: #             that string length and pattern properties
 4163: #             should be generated for it.
 4164: #
 4165: # Entry:      $input_spec  - the transform's input
 4166: #                            spec hashref. Currently
 4167: #                            unused; reserved for
 4168: #                            future input-type checks.
 4169: #             $output_spec - the transform's output
 4170: #                            spec hashref.
 4171: #
 4172: # Exit:       Returns 1 if the output type is 'string'.
 4173: #             Returns 0 otherwise.
 4174: #
 4175: # Side effects: None.
 4176: # --------------------------------------------------
 4177: sub _is_string_transform {
 4178: 	my ($input_spec, $output_spec) = @_;
 4179: 
 4180: 	# $input_spec is currently unused — reserved for future
 4181: 	# input-side type checking when detecting mixed transforms
 4182: 	my $out_type = ($output_spec // {})->{'type'} // '';
 4183: 
 4184: 	return($out_type eq 'string');
 4185: }
 4186: 
 4187: # --------------------------------------------------
 4188: # _same_type
 4189: #
 4190: # Purpose:    Determine whether the dominant type of
 4191: #             a transform's input and output specs
 4192: #             match, indicating that type-preservation
 4193: #             properties are meaningful.
 4194: #
 4195: # Entry:      $input_spec  - the transform's input
 4196: #                            spec hashref, or a nested
 4197: #                            multi-field hashref.
 4198: #             $output_spec - the transform's output
 4199: #                            spec hashref.
 4200: #
 4201: # Exit:       Returns 1 if the dominant input and
 4202: #             output types are identical strings.
 4203: #             Returns 0 otherwise.
 4204: #
 4205: # Side effects: None.
 4206: #
 4207: # Notes:      Uses _get_dominant_type for both sides.
 4208: #             For multi-field input specs, dominant
 4209: #             type is the type of the first field
 4210: #             encountered — this is a simplification.
 4211: #             TODO: extend to handle mixed-type inputs
 4212: #             by checking all fields, not just the
 4213: #             first one found.
 4214: # --------------------------------------------------
 4215: sub _same_type {
 4216: 	my ($input_spec, $output_spec) = @_;
 4217: 
 4218: 	# Guard: treat missing specs as untyped — two untyped
 4219: 	# specs both default to $DEFAULT_FIELD_TYPE and would
 4220: 	# compare equal, which is intentionally conservative
 4221: 	my $in_type  = _get_dominant_type($input_spec  // {});
 4222: 	my $out_type = _get_dominant_type($output_spec // {});
 4223: 
 4224: 	return($in_type eq $out_type);
 4225: }
 4226: 
 4227: # --------------------------------------------------
 4228: # _get_dominant_type
 4229: #
 4230: # Purpose:    Extract the most representative type
 4231: #             string from a spec hashref. For flat
 4232: #             output specs this is simply the 'type'
 4233: #             key. For multi-field input specs it is
 4234: #             the type of the first sub-field found
 4235: #             that declares one.
 4236: #
 4237: # Entry:      $spec - a spec hashref. May be a flat
 4238: #                     output spec ({ type => '...' })
 4239: #                     or a multi-field input spec
 4240: #                     ({ field => { type => '...' } }).
 4241: #                     May be undef or empty.
 4242: #
 4243: # Exit:       Returns a type string. Returns
 4244: #             $DEFAULT_FIELD_TYPE ('string') if no
 4245: #             type can be determined.
 4246: #
 4247: # Side effects: None.
 4248: # --------------------------------------------------
 4249: sub _get_dominant_type {
●4250 → 4261 → 4268●4250 → 4261 → 0 4250: 	my $spec = $_[0];
 4251: 
 4252: 	# Guard: return default for undef or non-hash input
 4253: 	return $DEFAULT_FIELD_TYPE
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4254: 		unless defined($spec) && ref($spec) eq 'HASH';
 4255: 
 4256: 	# Flat spec — type declared directly
 4257: 	return $spec->{'type'} if defined($spec->{'type'});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4258: 
 4259: 	# Multi-field spec — return the type of the first
 4260: 	# sub-field that declares one
 4261: 	for my $field (keys %{$spec}) {
 4262: 		next unless ref($spec->{$field}) eq 'HASH';
 4263: 		return $spec->{$field}{'type'}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4264: 			if defined($spec->{$field}{'type'});
 4265: 	}
 4266: 
 4267: 	# No type found anywhere — return the safe default
●4268 → 4268 → 0 4268: 	return $DEFAULT_FIELD_TYPE;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4269: }
 4270: 
 4271: # --------------------------------------------------
 4272: # _render_properties
 4273: #
 4274: # Purpose:    Render an arrayref of property definition
 4275: #             hashrefs (as produced by
 4276: #             _generate_transform_properties) into a
 4277: #             string of Perl source code suitable for
 4278: #             embedding in a generated test file.
 4279: #             The output uses Test::LectroTest::Compat
 4280: #             to run each property as a holds() check.
 4281: #
 4282: # Entry:      $properties - arrayref of property
 4283: #             hashrefs, each containing: name,
 4284: #             generator_spec, call_code,
 4285: #             property_checks, should_die,
 4286: #             should_warn, trials.
 4287: #             May be undef or an empty arrayref.
 4288: #
 4289: # Exit:       Returns a string of Perl source code.
 4290: #             Returns an empty string if $properties
 4291: #             is undef, not an arrayref, or empty.
 4292: #
 4293: # Side effects: None.
 4294: #
 4295: # Notes:      The generated code uses 4-space
 4296: #             indentation deliberately — this is the
 4297: #             indentation style of the generated test
 4298: #             file, not of this module. Tabs are used
 4299: #             in this module's own source; spaces are
 4300: #             emitted into generated output for
 4301: #             readability of the produced test files.
 4302: # --------------------------------------------------
 4303: sub _render_properties {
●4304 → 4313 → 4340●4304 → 4313 → 0 4304: 	my $properties = $_[0];
 4305: 
 4306: 	# Return empty string for absent or non-array input —
 4307: 	# callers treat '' as no property block to emit
 4308: 	return '' unless defined($properties) && ref($properties) eq 'ARRAY';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4309: 	return '' unless @{$properties};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4310: 
 4311: 	my $code = "use_ok('Test::LectroTest::Compat');\n\n";
 4312: 
 4313: 	for my $prop (@{$properties}) {
 4314: 		# Emit a labelled Property block for each transform property
 4315: 		$code .= "# Transform property: $prop->{'name'}\n";
 4316: 		$code .= "my \$$prop->{'name'} = Property {\n";
 4317: 		$code .= "    ##[ $prop->{'generator_spec'} ]##\n";
 4318: 		$code .= "    \n";
 4319: 		$code .= "    my \$result = eval { $prop->{'call_code'} };\n";
 4320: 
 4321: 		if($prop->{'should_die'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4322: 			# For transforms that expect death, pass if the
 4323: 			# eval caught an exception
 4324: 			$code .= "    my \$died = defined(\$\@) && \$\@;\n";
 4325: 			$code .= "    \$died;\n";
 4326: 		} else {
 4327: 			# For normal transforms, pass only if no exception
 4328: 			# was thrown and all property checks hold
 4329: 			$code .= "    my \$error = \$\@;\n";
 4330: 			$code .= "    \n";
 4331: 			$code .= "    !\$error && (\n";
 4332: 			$code .= "        $prop->{'property_checks'}\n";
 4333: 			$code .= "    );\n";
 4334: 		}
 4335: 
 4336: 		$code .= "}, name => '$prop->{'name'}', trials => $prop->{'trials'};\n\n";
 4337: 		$code .= "holds(\$$prop->{'name'});\n";
 4338: 	}
 4339: 
●4340 → 4340 → 0 4340: 	return $code;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4341: }
 4342: 
 4343: # --------------------------------------------------
 4344: # _detect_transform_properties
 4345: #
 4346: # Purpose:    Automatically derive a list of testable
 4347: #             LectroTest property hashrefs from a
 4348: #             transform's input and output specs.
 4349: #             Detects numeric range constraints, exact
 4350: #             value matches, string length constraints,
 4351: #             type preservation, and definedness.
 4352: #
 4353: # Entry:      $transform_name - string name of the
 4354: #                               transform, used for
 4355: #                               heuristic matching
 4356: #                               (e.g. 'positive').
 4357: #             $input_spec     - the transform's input
 4358: #                               hashref, or the string
 4359: #                               'undef'.
 4360: #             $output_spec    - the transform's output
 4361: #                               hashref, or undef if
 4362: #                               absent.
 4363: #
 4364: # Exit:       Returns a list of property hashrefs,
 4365: #             each containing 'name' and 'code' keys.
 4366: #             Returns an empty list if no properties
 4367: #             can be detected or if $input_spec is
 4368: #             undef or the string 'undef'.
 4369: #
 4370: # Side effects: None.
 4371: #
 4372: # Notes:      The 'positive' heuristic checks the
 4373: #             transform name case-insensitively against
 4374: #             $TRANSFORM_POSITIVE_PATTERN and adds a
 4375: #             non-negative constraint if matched.
 4376: #             This is intentionally a rough heuristic
 4377: #             rather than a precise semantic check.
 4378: # --------------------------------------------------
 4379: sub _detect_transform_properties {
●4380 → 4395 → 4425●4380 → 4395 → 0 4380: 	my ($transform_name, $input_spec, $output_spec) = @_;
 4381: 
 4382: 	my @properties;
 4383: 
 4384: 	# Guard: skip undef input and the YAML scalar 'undef'
 4385: 	return @properties unless defined($input_spec);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4386: 	return @properties if(!ref($input_spec) && $input_spec eq 'undef');
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4387: 
 4388: 	# Default output spec to empty hash so all key lookups
 4389: 	# below are safe regardless of what the schema provides
 4390: 	$output_spec //= {};
 4391: 
 4392: 	# --------------------------------------------------
 4393: 	# Property 1: Output range constraints (numeric)
 4394: 	# --------------------------------------------------
 4395: 	if(_is_numeric_transform($input_spec, $output_spec)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4396: 		if(defined($output_spec->{'min'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4397: 			my $min = $output_spec->{'min'};
 4398: 			push @properties, {
 4399: 				name => 'min_constraint',
 4400: 				code => "defined(\$result) && looks_like_number(\$result) && \$result >= $min",
 4401: 			};
 4402: 		}
 4403: 
 4404: 		if(defined($output_spec->{'max'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4405: 			my $max = $output_spec->{'max'};
 4406: 			push @properties, {
 4407: 				name => 'max_constraint',
 4408: 				code => "defined(\$result) && looks_like_number(\$result) && \$result <= $max",
 4409: 			};
 4410: 		}
 4411: 
 4412: 		# Heuristic: transforms named 'positive' (case-insensitive)
 4413: 		# imply a non-negative result constraint
 4414: 		if($transform_name =~ /$TRANSFORM_POSITIVE_PATTERN/i) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4415: 			push @properties, {
 4416: 				name => 'non_negative',
 4417: 				code => "defined(\$result) && looks_like_number(\$result) && \$result >= 0",
 4418: 			};
 4419: 		}
 4420: 	}
 4421: 
 4422: 	# --------------------------------------------------
 4423: 	# Property 2: Specific value output
 4424: 	# --------------------------------------------------
●4425 → 4425 → 4441●4425 → 4425 → 0 4425: 	if(defined($output_spec->{'value'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4426: 		my $expected = $output_spec->{'value'};
 4427: 
 4428: 		# Numeric refs use == for comparison; scalars use eq
 4429: 		# via perl_quote to produce the correct quoted literal
 4430: 		push @properties, {
 4431: 			name => 'exact_value',
 4432: 			code => ref($expected)
 4433: 				? "\$result == $expected"
 4434: 				: "\$result eq " . perl_quote($expected),
 4435: 		};
 4436: 	}
 4437: 
 4438: 	# --------------------------------------------------
 4439: 	# Property 3: String length constraints
 4440: 	# --------------------------------------------------
●4441 → 4441 → 4468●4441 → 4441 → 0 4441: 	if(_is_string_transform($input_spec, $output_spec)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4442: 		if(defined($output_spec->{'min'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4443: 			push @properties, {
 4444: 				name => 'min_length',
 4445: 				code => "length(\$result) >= $output_spec->{'min'}",
 4446: 			};
 4447: 		}
 4448: 
 4449: 		if(defined($output_spec->{'max'})) {

					

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

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

 4450: 			push @properties, {
 4451: 				name => 'max_length',
 4452: 				code => "length(\$result) <= $output_spec->{'max'}",
 4453: 			};
 4454: 		}
 4455: 
 4456: 		if(defined($output_spec->{'matches'})) {

					

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

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

 4457: 			my $pattern = $output_spec->{'matches'};
 4458: 			push @properties, {
 4459: 				name => 'pattern_match',
 4460: 				code => "\$result =~ qr/$pattern/",
 4461: 			};
 4462: 		}
 4463: 	}
 4464: 
 4465: 	# --------------------------------------------------
 4466: 	# Property 4: Type preservation
 4467: 	# --------------------------------------------------
●4468 → 4468 → 4487●4468 → 4468 → 0 4468: 	if(_same_type($input_spec, $output_spec)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4469: 		my $type = _get_dominant_type($output_spec);
 4470: 
 4471: 		# Only emit a numeric_type check for numeric types —
 4472: 		# string and other types have no equivalent simple check
 4473: 		if($type eq 'number' || $type eq 'integer' || $type eq 'float') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4474: 			push @properties, {
 4475: 				name => 'numeric_type',
 4476: 				code => 'looks_like_number($result)',
 4477: 			};
 4478: 		}
 4479: 	}
 4480: 
 4481: 	# --------------------------------------------------
 4482: 	# Property 5: Definedness
 4483: 	# --------------------------------------------------
 4484: 	# Emit a defined() check for all transforms except those
 4485: 	# whose output type is explicitly 'undef' — those are
 4486: 	# expected to return nothing
●4487 → 4487 → 4494●4487 → 4487 → 0 4487: 	unless(($output_spec->{'type'} // '') eq 'undef') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4488: 		push @properties, {
 4489: 			name => 'defined',
 4490: 			code => 'defined($result)',
 4491: 		};
 4492: 	}
 4493: 
●4494 → 4494 → 0 4494: 	return @properties;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4495: }
 4496: 
 4497: # --------------------------------------------------
 4498: # _process_custom_properties
 4499: #
 4500: # Purpose:    Process the 'properties' array from a
 4501: #             transform definition, resolving each
 4502: #             entry to either a named builtin property
 4503: #             (looked up from _get_builtin_properties)
 4504: #             or a custom property with inline code.
 4505: #
 4506: # Entry:      $properties_spec - arrayref of property
 4507: #                                definitions from the
 4508: #                                schema. Each element
 4509: #                                is either a string
 4510: #                                (builtin name) or a
 4511: #                                hashref with 'name'
 4512: #                                and 'code' fields.
 4513: #             $function        - name of the function
 4514: #                                under test.
 4515: #             $module          - module name, or undef
 4516: #                                for builtins.
 4517: #             $input_spec      - the transform's input
 4518: #                                spec hashref.
 4519: #             $output_spec     - the transform's output
 4520: #                                spec hashref.
 4521: #             $new             - defined if the function
 4522: #                                is an OO method; value
 4523: #                                is not used, only
 4524: #                                presence is checked.
 4525: #
 4526: # Exit:       Returns a list of property hashrefs,
 4527: #             each containing 'name', 'code', and
 4528: #             'description' keys.
 4529: #             Invalid or unrecognised entries are
 4530: #             skipped with a carp warning.
 4531: #
 4532: # Side effects: Carps on unrecognised builtin names,
 4533: #               missing code fields, and invalid
 4534: #               property definition types.
 4535: #
 4536: # Notes:      The sixth argument is $new (the OO
 4537: #             constructor signal), not the full schema
 4538: #             hashref. It is used only to determine
 4539: #             whether to emit OO-style call code for
 4540: #             builtin property templates.
 4541: # --------------------------------------------------
 4542: sub _process_custom_properties {
●4543 → 4548 → 4627●4543 → 4548 → 0 4543: 	my ($properties_spec, $function, $module, $input_spec, $output_spec, $new) = @_;
 4544: 
 4545: 	my @properties;
 4546: 	my $builtin_properties = _get_builtin_properties();
 4547: 
 4548: 	for my $prop_def (@{$properties_spec}) {
 4549: 		my $prop_name;
 4550: 		my $prop_code;
 4551: 		my $prop_desc;
 4552: 
 4553: 		if(!ref($prop_def)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4554: 			# Plain string — look up as a named builtin property
 4555: 			$prop_name = $prop_def;
 4556: 
 4557: 			unless(exists($builtin_properties->{$prop_name})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4558: 				carp "Unknown built-in property '$prop_name', skipping";
 4559: 				next;
 4560: 			}
 4561: 
 4562: 			my $builtin = $builtin_properties->{$prop_name};
 4563: 
 4564: 			# Build the argument list, respecting positional order
 4565: 			my @var_names = sort keys %{$input_spec};
 4566: 			my @args;
 4567: 			if(_has_positions($input_spec)) {

					

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

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

 4568: 				my @sorted = sort { $input_spec->{$a}{'position'} <=> $input_spec->{$b}{'position'} } @var_names;
 4569: 				@args = map { "\$$_" } @sorted;
 4570: 			} else {
 4571: 				@args = map { "\$$_" } @var_names;
 4572: 			}
 4573: 
 4574: 			# Build the call expression for the builtin template.
 4575: 			# $new here is the raw OO signal from the caller —
 4576: 			# defined means OO mode, undef means functional
 4577: 			my $call_code;
 4578: 			if($module && defined($new)) {

					

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

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

 4579: 				# OO mode — fresh object per trial
 4580: 				$call_code  = "my \$obj = new_ok('$module');";
 4581: 				$call_code .= "\$obj->$function";
 4582: 			} elsif($module && $module ne $MODULE_BUILTIN) {
 4583: 				# Functional mode with a named module
 4584: 				$call_code = "$module\::$function";
 4585: 			} else {
 4586: 				# Builtin or unqualified function call
 4587: 				$call_code = $function;
 4588: 			}
 4589: 			$call_code .= '(' . join(', ', @args) . ')';
 4590: 
 4591: 			# Instantiate the builtin's code template with the
 4592: 			# call expression and input variable list
 4593: 			$prop_code = $builtin->{'code_template'}->($function, $call_code, \@var_names);
 4594: 			$prop_desc = $builtin->{'description'};
 4595: 
 4596: 		} elsif(ref($prop_def) eq 'HASH') {
 4597: 			# Hashref — custom property with inline Perl code
 4598: 			$prop_name = $prop_def->{'name'} || 'custom_property';
 4599: 			$prop_code = $prop_def->{'code'};
 4600: 			$prop_desc = $prop_def->{'description'} || "Custom property: $prop_name";
 4601: 
 4602: 			unless($prop_code) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4603: 				carp "Custom property '$prop_name' missing 'code' field, skipping";
 4604: 				next;
 4605: 			}
 4606: 
 4607: 			# Sanity-check: code must contain at least a variable
 4608: 			# reference or a word character to be meaningful
 4609: 			unless($prop_code =~ /\$/ || $prop_code =~ /\w+/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4610: 				carp "Custom property '$prop_name' code looks invalid: $prop_code";
 4611: 				next;
 4612: 			}
 4613: 
 4614: 		} else {
 4615: 			# Neither string nor hashref — unrecognised definition type
 4616: 			carp 'Invalid property definition: ', render_fallback($prop_def);
 4617: 			next;
 4618: 		}
 4619: 
 4620: 		push @properties, {
 4621: 			name        => $prop_name,
 4622: 			code        => $prop_code,
 4623: 			description => $prop_desc,
 4624: 		};
 4625: 	}
 4626: 
●4627 → 4627 → 0 4627: 	return @properties;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4628: }
 4629: 
 4630: =head1 NOTES
 4631: 
 4632: C<seed> and C<iterations> really should be within C<config>.
 4633: 
 4634: =head1 SEE ALSO
 4635: 
 4636: =over 4
 4637: 
 4638: =item * L<Test Coverage Report|https://nigelhorne.github.io/App-Test-Generator/coverage/>
 4639: 
 4640: =item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>
 4641: 
 4642: =item * L<App::Test::Generator::SchemaExtractor> - Create schemas from Perl programs
 4643: 
 4644: =item * L<Params::Validate::Strict>: Schema Definition
 4645: 
 4646: =item * L<Params::Get>: Input validation
 4647: 
 4648: =item * L<Return::Set>: Output validation
 4649: 
 4650: =item * L<Test::LectroTest>
 4651: 
 4652: =item * L<Test::Most>
 4653: 
 4654: =item * L<YAML::XS>
 4655: 
 4656: =back
 4657: 
 4658: =head1 AUTHOR
 4659: 
 4660: Nigel Horne, C<< <njh at nigelhorne.com> >>
 4661: 
 4662: Portions of this module's initial design and documentation were created with the
 4663: assistance of AI.
 4664: 
 4665: =head1 SUPPORT
 4666: 
 4667: This module is provided as-is without any warranty.
 4668: 
 4669: You can find documentation for this module with the perldoc command.
 4670: 
 4671:     perldoc App::Test::Generator
 4672: 
 4673: You can also look for information at:
 4674: 
 4675: =over 4
 4676: 
 4677: =item * MetaCPAN
 4678: 
 4679: L<https://metacpan.org/release/App-Test-Generator>
 4680: 
 4681: =item * GitHub
 4682: 
 4683: L<https://github.com/nigelhorne/App-Test-Generator>
 4684: 
 4685: =item * CPANTS
 4686: 
 4687: L<http://cpants.cpanauthors.org/dist/App-Test-Generator>
 4688: 
 4689: =item * CPAN Testers' Matrix
 4690: 
 4691: L<http://matrix.cpantesters.org/?dist=App-Test-Generator>
 4692: 
 4693: =item * CPAN Testers Dependencies
 4694: 
 4695: L<http://deps.cpantesters.org/?module=App::Test::Generator>
 4696: 
 4697: =back
 4698: 
 4699: =head1 LICENCE AND COPYRIGHT
 4700: 
 4701: Copyright 2025-2026 Nigel Horne.
 4702: 
 4703: Usage is subject to the terms of GPL2.
 4704: If you use it,
 4705: please let me know.
 4706: 
 4707: =cut
 4708: 
 4709: 1;