lib/App/Test/Generator/CoverageGuidedFuzzer.pm

⬅ Previous Index Next ➡
Structural Coverage (Approximate)

TER1 (Statement): 91.91%
TER2 (Branch): 80.25%
TER3 (LCSAJ): 97.8% (45/46)
Approximate LCSAJ segments: 163

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows: 

        start → end → jump

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    1: package App::Test::Generator::CoverageGuidedFuzzer;
    2: 
    3: use strict;
    4: use warnings;
    5: use Carp    qw(croak);
    6: use feature 'state';
    7: use Readonly;
    8: 
    9: # --------------------------------------------------
   10: # Fuzzing loop parameters
   11: # --------------------------------------------------
   12: Readonly my $DEFAULT_ITERATIONS   => 100;
   13: Readonly my $CORPUS_MUTATE_RATIO  => 0.70;  # 70% mutate, 30% explore
   14: Readonly my $RANDOM_KEEP_RATIO    => 0.20;  # keep 20% random when no coverage
   15: Readonly my $EDGE_CASE_RATIO      => 0.40;  # 40% chance to use declared edge case
   16: Readonly my $INT_BOUNDARY_RATIO   => 0.30;  # 30% chance to use boundary int
   17: Readonly my $STR_BOUNDARY_RATIO   => 0.30;  # 30% chance to use boundary length
   18: Readonly my $SEED_CORPUS_SIZE     => 5;     # initial random inputs to seed corpus
   19: Readonly my $DEFAULT_MAX_STR_LEN  => 64;
   20: Readonly my $DEFAULT_MAX_ARRAY    => 4;     # max elements in random array (0..N)
   21: Readonly my $INT32_MAX            => 2**31 - 1;
   22: Readonly my $INT32_MIN            => -(2**31);
   23: 
   24: # --------------------------------------------------
   25: # Type name constants — used in schema dispatch
   26: # --------------------------------------------------
   27: Readonly my $TYPE_INTEGER => 'integer';
   28: Readonly my $TYPE_NUMBER  => 'number';
   29: Readonly my $TYPE_BOOLEAN => 'boolean';
   30: Readonly my $TYPE_ARRAY   => 'arrayref';
   31: Readonly my $TYPE_HASH    => 'hashref';
   32: Readonly my $TYPE_STRING  => 'string';
   33: 
   34: # --------------------------------------------------
   35: # JSON module preference order
   36: # --------------------------------------------------
   37: Readonly my @JSON_MODULES => qw(JSON::MaybeXS JSON);
   38: 
   39: our $VERSION = '0.36';
   40: 
   41: =head1 NAME
   42: 
   43: App::Test::Generator::CoverageGuidedFuzzer - AFL-style coverage-guided fuzzing for App::Test::Generator
   44: 
   45: =head1 VERSION
   46: 
   47: Version 0.36
   48: 
   49: =head1 SYNOPSIS
   50: 
   51:     use App::Test::Generator::CoverageGuidedFuzzer;
   52: 
   53:     my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
   54:         schema     => $yaml_schema,
   55:         target_sub => \&My::Module::validate,
   56:         iterations => 200,
   57:         seed       => 42,
   58:     );
   59: 
   60:     my $report = $fuzzer->run();
   61:     $fuzzer->save_corpus('t/corpus/validate.json');
   62: 
   63: =head1 DESCRIPTION
   64: 
   65: Implements coverage-guided fuzzing on top of App::Test::Generator's
   66: existing schema-driven input generation. Instead of purely random
   67: generation it:
   68: 
   69: =over 4
   70: 
   71: =item 1. Generates or mutates a structured input
   72: 
   73: =item 2. Runs the target sub under Devel::Cover to capture branch hits
   74: 
   75: =item 3. Keeps inputs that discover new branches in a corpus
   76: 
   77: =item 4. Preferentially mutates corpus entries in future iterations
   78: 
   79: =back
   80: 
   81: This is the Perl equivalent of what AFL/libFuzzer do at the byte level,
   82: but operating on typed, schema-validated Perl data structures.
   83: 
   84: =head1 METHODS
   85: 
   86: =head2 new
   87: 
   88: Construct a new coverage-guided fuzzer.
   89: 
   90:     my $fuzzer = App::Test::Generator::CoverageGuidedFuzzer->new(
   91:         schema     => $yaml_schema,
   92:         target_sub => \&My::Module::validate,
   93:         iterations => 200,
   94:         seed       => 42,
   95:         instance   => $obj,   # optional pre-built object for method calls
   96:     );
   97: 
   98: =head3 Arguments
   99: 
  100: =over 4
  101: 
  102: =item * C<schema>
  103: 
  104: A hashref representing the parsed YAML schema for the target function.
  105: Required.
  106: 
  107: =item * C<target_sub>
  108: 
  109: A CODE reference to the function under test. Required.
  110: 
  111: =item * C<iterations>
  112: 
  113: Number of fuzzing iterations to run. Optional - defaults to 100.
  114: 
  115: =item * C<seed>
  116: 
  117: Random seed for reproducible runs. Optional - defaults to C<time()>.
  118: 
  119: =item * C<instance>
  120: 
  121: An optional pre-built object to use as the invocant when calling the
  122: target sub as a method.
  123: 
  124: =back
  125: 
  126: =head3 Returns
  127: 
  128: A blessed hashref. Croaks if C<schema> or C<target_sub> is missing.
  129: 
  130: =head3 API specification
  131: 
  132: =head4 input
  133: 
  134:     {
  135:         schema     => { type => HASHREF },
  136:         target_sub => { type => CODEREF },
  137:         iterations => { type => SCALAR,  optional => 1 },
  138:         seed       => { type => SCALAR,  optional => 1 },
  139:         instance   => { type => OBJECT,  optional => 1 },
  140:     }
  141: 
  142: =head4 output
  143: 
  144:     {
  145:         type => OBJECT,
  146:         isa  => 'App::Test::Generator::CoverageGuidedFuzzer',
  147:     }
  148: 
  149: =cut
  150: 
  151: sub new {
●152 → 182 → 186●152 → 182 → 0  152: 	my ($class, %args) = @_;
  153: 
  154: 	croak 'schema required'     unless $args{schema};
  155: 	croak 'target_sub required' unless $args{target_sub};
  156: 
  157: 	my $self = bless {
  158: 		schema     => $args{schema},
  159: 		target_sub => $args{target_sub},
  160: 		instance   => $args{instance},
  161: 		iterations => $args{iterations} // $DEFAULT_ITERATIONS,
  162: 		seed       => $args{seed}       // time(),
  163: 		corpus     => [],   # [{input => ..., coverage => {...}}]
  164: 		covered    => {},   # "file:line:branch" => 1
  165: 		bugs       => [],   # [{input => ..., error => ...}]
  166: 		stats      => {
  167: 			total       => 0,
  168: 			interesting => 0,
  169: 			bugs        => 0,
  170: 			coverage    => 0,
  171: 		},
  172: 		_cover_available => undef,
  173: 	}, $class;
  174: 
  175: 	srand($self->{seed});
  176: 
  177: 	# Probe for Devel::Cover availability once at construction time
  178: 	$self->{_cover_available} = eval { require Devel::Cover; 1 } ? 1 : 0;
  179: 
  180: 	# Warn once per process if coverage guidance is unavailable
  181: 	state $cover_warned = 0;
  182: 	if(!$self->{_cover_available} && !$cover_warned++) {

					

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

  183: 		warn 'Devel::Cover not available; fuzzing without coverage guidance.';
  184: 	}
  185: 
●186 → 186 → 0  186: 	return $self;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  187: }
  188: 
  189: =head2 run
  190: 
  191: Run the coverage-guided fuzzing loop and return a summary report.
  192: 
  193:     my $report = $fuzzer->run();
  194:     printf "Branches covered: %d\n", $report->{branches_covered};
  195:     printf "Bugs found:       %d\n", $report->{bugs_found};
  196: 
  197: =head3 Arguments
  198: 
  199: None beyond C<$self>.
  200: 
  201: =head3 Returns
  202: 
  203: A hashref with keys C<total_iterations>, C<interesting_inputs>,
  204: C<corpus_size>, C<branches_covered>, C<bugs_found>, and C<bugs>.
  205: 
  206: =head3 API specification
  207: 
  208: =head4 input
  209: 
  210:     {
  211:         self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' },
  212:     }
  213: 
  214: =head4 output
  215: 
  216:     {
  217:         type => HASHREF,
  218:         keys => {
  219:             total_iterations   => { type => SCALAR  },
  220:             interesting_inputs => { type => SCALAR  },
  221:             corpus_size        => { type => SCALAR  },
  222:             branches_covered   => { type => SCALAR  },
  223:             bugs_found         => { type => SCALAR  },
  224:             bugs               => { type => ARRAYREF },
  225:         },
  226:     }
  227: 
  228: =cut
  229: 
  230: sub run {
●231 → 237 → 253●231 → 237 → 0  231: 	my ($self) = @_;
  232: 
  233: 	# Phase 1: seed the corpus with a small set of random inputs
  234: 	$self->_seed_corpus();
  235: 
  236: 	# Phase 2: main fuzzing loop — alternate between mutation and exploration
  237: 	for my $i (1 .. $self->{iterations}) {
  238: 		my $input;
  239: 
  240: 		if(@{ $self->{corpus} } && rand() < $CORPUS_MUTATE_RATIO) {

					

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

  241: 			# Mutate a randomly chosen corpus entry
  242: 			my $parent = $self->{corpus}[ int(rand(@{ $self->{corpus} })) ];
  243: 			$input = $self->_mutate($parent->{input});
  244: 		} else {
  245: 			# Fresh random generation for exploration
  246: 			$input = $self->_generate_random();
  247: 		}
  248: 
  249: 		$self->_run_one($input);
  250: 		$self->{stats}{total}++;
  251: 	}
  252: 
●253 → 254 → 0  253: 	$self->{stats}{coverage} = scalar keys %{ $self->{covered} };
  254: 	return $self->_build_report();

  Mutants (Total: 2, Killed: 2, Survived: 0)
  255: }
  256: 
  257: =head2 corpus
  258: 
  259: Return the accumulated corpus as an arrayref of hashrefs with keys
  260: C<input> and C<coverage>.
  261: 
  262:     my $corpus = $fuzzer->corpus();
  263: 
  264: =head3 API specification
  265: 
  266: =head4 input
  267: 
  268:     { self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' } }
  269: 
  270: =head4 output
  271: 
  272:     { type => ARRAYREF }
  273: 
  274: =cut
  275: 
  276: sub corpus { $_[0]->{corpus} }
  277: 
  278: =head2 bugs
  279: 
  280: Return bugs found as an arrayref of hashrefs with keys C<input> and
  281: C<error>.
  282: 
  283:     my $bugs = $fuzzer->bugs();
  284: 
  285: =head3 API specification
  286: 
  287: =head4 input
  288: 
  289:     { self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' } }
  290: 
  291: =head4 output
  292: 
  293:     { type => ARRAYREF }
  294: 
  295: =cut
  296: 
  297: sub bugs { $_[0]->{bugs} }
  298: 
  299: =head2 save_corpus
  300: 
  301: Serialise the corpus to a JSON file for replay or extension on future
  302: runs.
  303: 
  304:     $fuzzer->save_corpus('t/corpus/validate.json');
  305: 
  306: =head3 Arguments
  307: 
  308: =over 4
  309: 
  310: =item * C<$path>
  311: 
  312: Path to write the JSON corpus file. Required.
  313: 
  314: =back
  315: 
  316: =head3 Returns
  317: 
  318: Nothing. Croaks if the file cannot be written or no JSON module is
  319: available.
  320: 
  321: =head3 Side effects
  322: 
  323: Writes a JSON file to C<$path>.
  324: 
  325: =head3 API specification
  326: 
  327: =head4 input
  328: 
  329:     {
  330:         self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' },
  331:         path => { type => SCALAR },
  332:     }
  333: 
  334: =head4 output
  335: 
  336:     { type => UNDEF }
  337: 
  338: =cut
  339: 
  340: sub save_corpus {
  341: 	my ($self, $path) = @_;
  342: 
  343: 	croak 'path required' unless defined $path;
  344: 
  345: 	my $json = _load_json_module();
  346: 
  347: 	open my $fh, '>', $path
  348: 		or croak "Cannot write corpus to $path: $!";
  349: 
  350: 	print $fh $json->new->pretty->encode({
  351: 		seed   => $self->{seed},
  352: 		corpus => [ map { { input => $_->{input} } } @{ $self->{corpus} } ],
  353: 		bugs   => $self->{bugs},
  354: 	});
  355: 
  356: 	close $fh;
  357: }
  358: 
  359: =head2 load_corpus
  360: 
  361: Load a previously saved corpus JSON file, pre-seeding the fuzzer so
  362: it continues from where it left off.
  363: 
  364:     $fuzzer->load_corpus('t/corpus/validate.json');
  365: 
  366: =head3 Arguments
  367: 
  368: =over 4
  369: 
  370: =item * C<$path>
  371: 
  372: Path to the JSON corpus file to load. Required.
  373: 
  374: =back
  375: 
  376: =head3 Returns
  377: 
  378: Nothing. Croaks if the file cannot be read or no JSON module is
  379: available.
  380: 
  381: =head3 Side effects
  382: 
  383: Appends loaded entries to C<< $self->{corpus} >>.
  384: 
  385: =head3 API specification
  386: 
  387: =head4 input
  388: 
  389:     {
  390:         self => { type => OBJECT, isa => 'App::Test::Generator::CoverageGuidedFuzzer' },
  391:         path => { type => SCALAR },
  392:     }
  393: 
  394: =head4 output
  395: 
  396:     { type => UNDEF }
  397: 
  398: =cut
  399: 
  400: sub load_corpus {
●401 → 415 → 0  401: 	my ($self, $path) = @_;
  402: 
  403: 	croak 'path required' unless defined $path;
  404: 
  405: 	my $json = _load_json_module();
  406: 
  407: 	open my $fh, '<', $path
  408: 		or croak "Cannot read corpus from $path: $!";
  409: 
  410: 	my $data = $json->new->decode(do { local $/; <$fh> });
  411: 	close $fh;
  412: 
  413: 	# Load corpus entries with empty coverage — coverage state from a
  414: 	# previous process cannot be restored, only the inputs themselves
  415: 	for my $entry (@{ $data->{corpus} // [] }) {
  416: 		push @{ $self->{corpus} }, {
  417: 			input    => $entry->{input},
  418: 			coverage => {},
  419: 		};
  420: 	}
  421: }
  422: 
  423: # --------------------------------------------------
  424: # _load_json_module
  425: #
  426: # Find and load the first available JSON
  427: #     module from the preference list.
  428: #
  429: # Entry:      None.
  430: # Exit:       Returns the name of the loaded module.
  431: #             Croaks if none are available.
  432: #
  433: # Side effects: Loads a JSON module into the process.
  434: #
  435: # Notes:      Uses explicit require rather than string
  436: #             eval for safety. JSON::MaybeXS is
  437: #             preferred over JSON.
  438: # --------------------------------------------------
  439: sub _load_json_module {
●440 → 440 → 448●440 → 440 → 0  440: 	for my $mod (@JSON_MODULES) {
  441: 		# Convert package name to file path — require $var does not
  442: 		# do the :: -> / conversion that bareword require does
  443: 		(my $file = $mod) =~ s{::}{/}g;
  444: 		$file .= '.pm';
  445: 		my $ok = eval { require $file; 1 };
  446: 		return $mod if $ok;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  447: 	}
●[NOT COVERED] 448 → 448 → 0  448: 	croak 'No JSON module available; install JSON or JSON::MaybeXS';
  449: }
  450: 
  451: # --------------------------------------------------
  452: # _run_one
  453: #
  454: # Run the target sub with a single input,
  455: #     record coverage, detect bugs, and update
  456: #     the corpus if the input is interesting.
  457: #
  458: # Entry:      $input - the value to pass to target_sub.
  459: #
  460: # Exit:       Returns nothing. Updates $self->{corpus},
  461: #             $self->{bugs}, and $self->{covered}.
  462: #
  463: # Side effects: Calls target_sub. May update corpus
  464: #               and covered hashes.
  465: #
  466: # Notes:      When Devel::Cover is available, coverage
  467: #             is captured via _run_with_cover.
  468: #             Unexpected warnings are treated as soft
  469: #             bugs if they match known warning patterns.
  470: # --------------------------------------------------
  471: sub _run_one {
●472 → 476 → 504●472 → 476 → 0  472: 	my ($self, $input) = @_;
  473: 
  474: 	my ($result, $error, $coverage);
  475: 
  476: 	if($self->{_cover_available}) {

					

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

  477: 		$coverage = $self->_run_with_cover($input, \$result, \$error);
  478: 	} else {
  479: 		$coverage = {};
  480: 
  481: 		# Include instance as invocant for method calls
  482: 		my @call_args = defined($self->{instance})
  483: 			? ($self->{instance}, $input)
  484: 			: ($input);
  485: 
  486: 		my @warnings;
  487: 		eval {
  488: 			local $SIG{__WARN__} = sub { push @warnings, @_ };
  489: 			local $SIG{__DIE__};
  490: 			$result = $self->{target_sub}->(@call_args);
  491: 		};
  492: 		$error = $@ if $@;
  493: 
  494: 		# Treat unexpected warnings matching known bad patterns as soft bugs
  495: 		if(!defined($error) && @warnings) {

					

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

  496: 			my $w = join '', @warnings;
  497: 			$error = "warning: $w"
  498: 				if $w =~ /uninitialized|undefined|blessed|invalid/i;
  499: 		}
  500: 	}
  501: 
  502: 	# Record bugs — only when the input was valid per the schema.
  503: 	# A die on invalid input is correct behaviour, not a bug.
●504 → 504 → 510●504 → 504 → 0  504: 	if($error && $self->_input_is_valid($input)) {

					

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

  505: 		push @{ $self->{bugs} }, { input => $input, error => "$error" };
  506: 		$self->{stats}{bugs}++;
  507: 	}
  508: 
  509: 	# Keep the input in the corpus if it exercised new branches
●510 → 510 → 0  510: 	if($self->_is_interesting($coverage)) {

					

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

  511: 		push @{ $self->{corpus} }, { input => $input, coverage => $coverage };
  512: 		$self->_update_covered($coverage);
  513: 		$self->{stats}{interesting}++;
  514: 	}
  515: }
  516: 
  517: # --------------------------------------------------
  518: # _run_with_cover
  519: #
  520: # Purpose:    Run the target sub with Devel::Cover
  521: #             active and return the set of newly hit
  522: #             branches as a hashref.
  523: #
  524: # Entry:      $input      - value to pass to target_sub.
  525: #             $result_ref - scalar ref to store result.
  526: #             $error_ref  - scalar ref to store error.
  527: #
  528: # Exit:       Returns a hashref of newly hit branch
  529: #             keys ("file:line:branch").
  530: #
  531: # Side effects: Calls Devel::Cover::start/stop.
  532: #               Sets $$result_ref and $$error_ref.
  533: #
  534: # Notes:      Snapshot comparison is imprecise for
  535: #             concurrent use but correct for single-
  536: #             threaded fuzzing. Instance is passed
  537: #             as invocant when set.
  538: # --------------------------------------------------
  539: sub _run_with_cover {
●540 → 562 → 566●540 → 562 → 0  540: 	my ($self, $input, $result_ref, $error_ref) = @_;
  541: 
  542: 	Devel::Cover::start() if Devel::Cover->can('start');
  543: 
  544: 	my %before = $self->_snapshot_cover();
  545: 
  546: 	# Include instance as invocant for method calls
  547: 	my @call_args = defined($self->{instance})
  548: 		? ($self->{instance}, $input)
  549: 		: ($input);
  550: 
  551: 	eval {
  552: 		local $SIG{__DIE__};
  553: 		$$result_ref = $self->{target_sub}->(@call_args);
  554: 	};
  555: 	$$error_ref = $@ if $@;
  556: 
  557: 	my %after = $self->_snapshot_cover();
  558: 	Devel::Cover::stop() if Devel::Cover->can('stop');
  559: 
  560: 	# Return only branches newly hit in this call
  561: 	my %delta;
  562: 	for my $key (keys %after) {
  563: 		$delta{$key} = 1 unless exists $before{$key};
  564: 	}
  565: 
●566 → 566 → 0  566: 	return \%delta;
  567: }
  568: 
  569: # --------------------------------------------------
  570: # _snapshot_cover
  571: #
  572: # Purpose:    Take a lightweight snapshot of the
  573: #             currently hit branches from Devel::Cover.
  574: #
  575: # Entry:      None beyond $self.
  576: # Exit:       Returns a hash of "file:line:branch" keys.
  577: #
  578: # Side effects: Reads Devel::Cover internal state.
  579: #
  580: # Notes:      Falls back to empty hash if the
  581: #             Devel::Cover API is not accessible.
  582: #             All errors are silently swallowed since
  583: #             coverage is best-effort.
  584: # --------------------------------------------------
  585: sub _snapshot_cover {
  586: 	my ($self) = @_;
  587: 	my %snap;
  588: 
  589: 	eval {
  590: 		my $cover = Devel::Cover::get_coverage();
  591: 		return unless $cover;
  592: 
  593: 		for my $file (keys %{$cover}) {
  594: 			my $branch = $cover->{$file}{branch} or next;
  595: 			for my $line (keys %{$branch}) {
  596: 				for my $b (0 .. $#{ $branch->{$line} }) {
  597: 					$snap{"$file:$line:$b"} = 1
  598: 						if $branch->{$line}[$b];
  599: 				}
  600: 			}
  601: 		}
  602: 	};
  603: 
  604: 	return %snap;

					

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

  605: }
  606: 
  607: # --------------------------------------------------
  608: # _is_interesting
  609: #
  610: # Purpose:    Return true if the coverage hashref
  611: #             contains any branch not yet in the
  612: #             global covered set.
  613: #
  614: # Entry:      $coverage - hashref of branch keys.
  615: # Exit:       Returns 1 if interesting, 0 otherwise.
  616: #
  617: # Side effects: None.
  618: #
  619: # Notes:      When no coverage data is available,
  620: #             keeps a random sample of inputs at
  621: #             RANDOM_KEEP_RATIO so the corpus still
  622: #             grows even without branch feedback.
  623: # --------------------------------------------------
  624: sub _is_interesting {
●625 → 628 → 633●625 → 628 → 0  625: 	my ($self, $coverage) = @_;
  626: 
  627: 	# Check for any newly covered branch
  628: 	for my $key (keys %{$coverage}) {
  629: 		return 1 unless $self->{covered}{$key};

  Mutants (Total: 2, Killed: 2, Survived: 0)
  630: 	}
  631: 
  632: 	# No coverage data — keep a random sample to grow the corpus
●633 → 635 → 0  633: 	return rand() < $RANDOM_KEEP_RATIO unless %{$coverage};

					

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

  634: 
  635: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  636: }
  637: 
  638: # --------------------------------------------------
  639: # _update_covered
  640: #
  641: # Purpose:    Merge newly covered branches into the
  642: #             global covered set.
  643: #
  644: # Entry:      $coverage - hashref of branch keys.
  645: # Exit:       Returns nothing. Updates $self->{covered}.
  646: # Side effects: Modifies $self->{covered}.
  647: # --------------------------------------------------
  648: sub _update_covered {
  649: 	my ($self, $coverage) = @_;
  650: 	$self->{covered}{$_} = 1 for keys %{$coverage};
  651: }
  652: 
  653: # --------------------------------------------------
  654: # _generate_random
  655: #
  656: # Purpose:    Generate a random input value from the
  657: #             top-level schema input specification.
  658: #
  659: # Entry:      None beyond $self.
  660: # Exit:       Returns a randomly generated value.
  661: # Side effects: None.
  662: # --------------------------------------------------
  663: sub _generate_random {
  664: 	my ($self) = @_;
  665: 	return $self->_generate_for_schema($self->{schema}{input});

					

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

  666: }
  667: 
  668: # --------------------------------------------------
  669: # _generate_for_schema
  670: #
  671: # Purpose:    Recursively generate a random value
  672: #             matching a schema specification hashref.
  673: #
  674: # Entry:      $spec - schema spec hashref or scalar
  675: #             type hint.
  676: #
  677: # Exit:       Returns a generated value appropriate
  678: #             for the spec type, or undef if spec is
  679: #             absent or 'undef'.
  680: #
  681: # Side effects: None.
  682: #
  683: # Notes:      Edge cases declared in edge_case_array
  684: #             are selected at EDGE_CASE_RATIO frequency
  685: #             to bias toward known interesting values.
  686: # --------------------------------------------------
  687: sub _generate_for_schema {
●688 → 696 → 702●688 → 696 → 0  688: 	my ($self, $spec) = @_;
  689: 
  690: 	return undef unless defined $spec;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  691: 	return undef if $spec eq 'undef';

  Mutants (Total: 2, Killed: 2, Survived: 0)
  692: 
  693: 	my $type = ref($spec) ? ($spec->{type} // $TYPE_STRING) : $TYPE_STRING;
  694: 
  695: 	# Bias toward declared edge cases at EDGE_CASE_RATIO frequency
  696: 	if(ref($spec) && $spec->{edge_case_array} && rand() < $EDGE_CASE_RATIO) {

					

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

  697: 		my @ec = @{ $spec->{edge_case_array} };
  698: 		return $ec[ int(rand(@ec)) ];
  699: 	}
  700: 
  701: 	# Dispatch to type-specific generator
●702 → 702 → 0  702: 	if    ($type eq $TYPE_INTEGER) { return $self->_rand_int($spec)    }

  Mutants (Total: 3, Killed: 3, Survived: 0)
  703: 	elsif ($type eq $TYPE_NUMBER)  { return $self->_rand_num($spec)    }

					

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

  704: 	elsif ($type eq $TYPE_BOOLEAN) { return int(rand(2))               }
  705: 	elsif ($type eq $TYPE_ARRAY)   { return $self->_rand_array($spec)  }

  Mutants (Total: 2, Killed: 2, Survived: 0)
  706: 	elsif ($type eq $TYPE_HASH)    { return $self->_rand_hash($spec)   }

  Mutants (Total: 2, Killed: 2, Survived: 0)
  707: 	else                           { return $self->_rand_string($spec) }

					

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

  708: }
  709: 
  710: # --------------------------------------------------
  711: # _rand_int
  712: #
  713: # Purpose:    Generate a random integer within the
  714: #             spec's min/max range, biased toward
  715: #             boundary values at INT_BOUNDARY_RATIO.
  716: #
  717: # Entry:      $spec - schema spec hashref.
  718: # Exit:       Returns an integer scalar.
  719: # Side effects: None.
  720: # --------------------------------------------------
  721: sub _rand_int {
●722 → 728 → 733●722 → 728 → 0  722: 	my ($self, $spec) = @_;
  723: 
  724: 	my $min = $spec->{min} // $INT32_MIN;
  725: 	my $max = $spec->{max} // $INT32_MAX;
  726: 
  727: 	# Bias toward boundary values to probe edge conditions
  728: 	if(rand() < $INT_BOUNDARY_RATIO) {

					

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

  729: 		my @interesting = ($min, $min + 1, 0, -1, 1, $max - 1, $max);
  730: 		return $interesting[ int(rand(@interesting)) ];
  731: 	}
  732: 
●733 → 733 → 0  733: 	return $min + int(rand($max - $min + 1));

					

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

  734: }
  735: 
  736: # --------------------------------------------------
  737: # _rand_num
  738: #
  739: # Purpose:    Generate a random floating point number
  740: #             within the spec's min/max range.
  741: #
  742: # Entry:      $spec - schema spec hashref.
  743: # Exit:       Returns a numeric scalar.
  744: # Side effects: None.
  745: # --------------------------------------------------
  746: sub _rand_num {
  747: 	my ($self, $spec) = @_;
  748: 
  749: 	my $min = $spec->{min} // -1e9;
  750: 	my $max = $spec->{max} //  1e9;
  751: 
  752: 	return $min + rand($max - $min);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  753: }
  754: 
  755: # --------------------------------------------------
  756: # _rand_string
  757: #
  758: # Purpose:    Generate a random string within the
  759: #             spec's min/max length range, biased
  760: #             toward boundary lengths.
  761: #
  762: # Entry:      $spec - schema spec hashref.
  763: # Exit:       Returns a string scalar.
  764: # Side effects: None.
  765: #
  766: # Notes:      Character set includes control chars
  767: #             and NUL to probe boundary handling.
  768: # --------------------------------------------------
  769: sub _rand_string {
●770 → 777 → 785●770 → 777 → 0  770: 	my ($self, $spec) = @_;
  771: 
  772: 	my $min_len = $spec->{min} // 0;
  773: 	my $max_len = $spec->{max} // $DEFAULT_MAX_STR_LEN;
  774: 
  775: 	# Bias toward boundary lengths at STR_BOUNDARY_RATIO frequency
  776: 	my $len;
  777: 	if(rand() < $STR_BOUNDARY_RATIO) {

					

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

  778: 		my @boundary_lens = ($min_len, $min_len + 1, $max_len - 1, $max_len);
  779: 		$len = $boundary_lens[ int(rand(@boundary_lens)) ];
  780: 	} else {
  781: 		$len = $min_len + int(rand($max_len - $min_len + 1));
  782: 	}
  783: 
  784: 	# Clamp to non-negative
●785 → 788 → 0  785: 	$len = 0 if $len < 0;

					

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

  786: 
  787: 	my @chars = ('a'..'z', 'A'..'Z', '0'..'9', ' ', "\t", "\n", "\0");
  788: 	return join '', map { $chars[ int(rand(@chars)) ] } 1 .. $len;
  789: }
  790: 
  791: # --------------------------------------------------
  792: # _rand_array
  793: #
  794: # Purpose:    Generate a random arrayref with 0 to
  795: #             DEFAULT_MAX_ARRAY elements, each
  796: #             generated from the items spec.
  797: #
  798: # Entry:      $spec - schema spec hashref.
  799: # Exit:       Returns an arrayref.
  800: # Side effects: None.
  801: # --------------------------------------------------
  802: sub _rand_array {
  803: 	my ($self, $spec) = @_;
  804: 
  805: 	my $items = $spec->{items} // {};
  806: 	my $count = int(rand($DEFAULT_MAX_ARRAY + 1));
  807: 
  808: 	return [ map { $self->_generate_for_schema($items) } 1 .. $count ];
  809: }
  810: 
  811: # --------------------------------------------------
  812: # _rand_hash
  813: #
  814: # Purpose:    Generate a random hashref with values
  815: #             generated from the properties spec.
  816: #
  817: # Entry:      $spec - schema spec hashref.
  818: # Exit:       Returns a hashref.
  819: # Side effects: None.
  820: # --------------------------------------------------
  821: sub _rand_hash {
●822 → 827 → 831●822 → 827 → 0  822: 	my ($self, $spec) = @_;
  823: 
  824: 	my $props = $spec->{properties} // {};
  825: 	my %h;
  826: 
  827: 	for my $key (keys %{$props}) {
  828: 		$h{$key} = $self->_generate_for_schema($props->{$key});
  829: 	}
  830: 
●831 → 831 → 0  831: 	return \%h;
  832: }
  833: 
  834: # --------------------------------------------------
  835: # _input_is_valid
  836: #
  837: # Purpose:    Return true if the input satisfies all
  838: #             constraints in the schema. Used to
  839: #             distinguish real bugs (die on valid
  840: #             input) from expected failures (die on
  841: #             invalid input).
  842: #
  843: # Entry:      $input - the value to validate.
  844: # Exit:       Returns 1 if valid, 0 if not.
  845: #             Returns 1 if no schema is available.
  846: # Side effects: None.
  847: # --------------------------------------------------
  848: sub _input_is_valid {
●849 → 858 → 862●849 → 858 → 0  849: 	my ($self, $input) = @_;
  850: 
  851: 	my $spec = $self->{schema}{input};
  852: 
  853: 	# No schema means we cannot judge validity
  854: 	return 1 unless defined $spec && ref($spec);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  855: 
  856: 	my $input_style = $self->{schema}{input_style} // '';
  857: 
  858: 	if($input_style eq 'hash' || ref($input) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  859: 		return $self->_validate_hash_input($input, $spec);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  860: 	}
  861: 
●862 → 862 → 0  862: 	return $self->_validate_value($input, $spec);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  863: }
  864: 
  865: # --------------------------------------------------
  866: # _validate_hash_input
  867: #
  868: # Purpose:    Validate a hash-style input against the
  869: #             schema spec, checking each named field.
  870: #
  871: # Entry:      $input - hashref of named parameters.
  872: #             $spec  - schema spec hashref.
  873: # Exit:       Returns 1 if valid, 0 if not.
  874: # Side effects: None.
  875: # --------------------------------------------------
  876: sub _validate_hash_input {
●877 → 881 → 900●877 → 881 → 0  877: 	my ($self, $input, $spec) = @_;
  878: 
  879: 	return 0 unless defined $input;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  880: 
  881: 	for my $key (keys %{$spec}) {
  882: 		# Skip internal metadata keys
  883: 		next if $key =~ /^_/;
  884: 
  885: 		my $field_spec = $spec->{$key};
  886: 		next unless ref($field_spec) eq 'HASH';
  887: 
  888: 		my $value = ref($input) eq 'HASH' ? $input->{$key} : undef;
  889: 
  890: 		# Required field missing is always invalid
  891: 		if(!defined($value) && !$field_spec->{optional}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  892: 			return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  893: 		}
  894: 
  895: 		next unless defined $value;
  896: 
  897: 		return 0 unless $self->_validate_value($value, $field_spec);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  898: 	}
  899: 
●900 → 900 → 0  900: 	return 1;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  901: }
  902: 
  903: # --------------------------------------------------
  904: # _validate_value
  905: #
  906: # Purpose:    Validate a single value against a schema
  907: #             type spec, checking type and constraints.
  908: #
  909: # Entry:      $value - the value to validate.
  910: #             $spec  - schema spec hashref.
  911: # Exit:       Returns 1 if valid, 0 if not.
  912: # Side effects: None.
  913: #
  914: # Notes:      Number validation accepts both integer
  915: #             and floating point forms including
  916: #             scientific notation. Type mismatch
  917: #             always returns 0.
  918: # --------------------------------------------------
  919: sub _validate_value {
●920 → 927 → 957●920 → 927 → 0  920: 	my ($self, $value, $spec) = @_;
  921: 
  922: 	# Undef is never valid unless optional — caller already checked optional
  923: 	return 0 unless defined $value;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  924: 
  925: 	my $type = $spec->{type} // $TYPE_STRING;
  926: 
  927: 	if($type eq $TYPE_INTEGER) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  928: 		return 0 unless $value =~ /^-?\d+$/;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  929: 		return 0 if defined($spec->{min}) && $value < $spec->{min};

  Mutants (Total: 5, Killed: 5, Survived: 0)
  930: 		return 0 if defined($spec->{max}) && $value > $spec->{max};

  Mutants (Total: 5, Killed: 5, Survived: 0)
  931: 	}
  932: 	elsif($type eq $TYPE_NUMBER) {
  933: 		# Accept integers, decimals, and scientific notation
  934: 		return 0 unless $value =~ /^-?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?$/;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  935: 		return 0 if defined($spec->{min}) && $value < $spec->{min};

					

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

  936: 		return 0 if defined($spec->{max}) && $value > $spec->{max};

					

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

  937: 	}
  938: 	elsif($type eq $TYPE_STRING) {
  939: 		my $len = length($value);
  940: 		return 0 if defined($spec->{min}) && $len < $spec->{min};

  Mutants (Total: 5, Killed: 5, Survived: 0)
  941: 		return 0 if defined($spec->{max}) && $len > $spec->{max};

  Mutants (Total: 5, Killed: 5, Survived: 0)
  942: 		if(defined($spec->{matches})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  943: 			(my $pat = $spec->{matches}) =~ s{^/(.+)/$}{$1};
  944: 			return 0 unless $value =~ /$pat/;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  945: 		}
  946: 	}
  947: 	elsif($type eq $TYPE_BOOLEAN) {
  948: 		return 0 unless $value =~ /^[01]$/;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  949: 	}
  950: 	elsif($type eq $TYPE_ARRAY || $type eq 'array') {
  951: 		return 0 unless ref($value) eq 'ARRAY';

  Mutants (Total: 2, Killed: 2, Survived: 0)
  952: 	}
  953: 	elsif($type eq $TYPE_HASH || $type eq 'hash') {
  954: 		return 0 unless ref($value) eq 'HASH';

  Mutants (Total: 2, Killed: 2, Survived: 0)
  955: 	}
  956: 
●957 → 957 → 0  957: 	return 1;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  958: }
  959: 
  960: # --------------------------------------------------
  961: # _mutate
  962: #
  963: # Purpose:    Apply a random mutation to an input
  964: #             value, dispatching on its type.
  965: #
  966: # Entry:      $input - the value to mutate.
  967: # Exit:       Returns a mutated copy of the input.
  968: # Side effects: None.
  969: #
  970: # Notes:      Blessed references are passed through
  971: #             unchanged. Undef is replaced with a
  972: #             freshly generated random value.
  973: # --------------------------------------------------
  974: sub _mutate {
●975 → 979 → 1001●975 → 979 → 0  975: 	my ($self, $input) = @_;
  976: 
  977: 	my $type = ref($input);
  978: 
  979: 	if(!defined $input) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  980: 		# Replace undef with a fresh random value
  981: 		return $self->_generate_random();

					

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

  982: 	}
  983: 	elsif(!$type) {
  984: 		# Dispatch scalar mutation based on apparent type
  985: 		if($input =~ /^-?\d+$/) {

					

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

  986: 			return $self->_mutate_int($input);

					

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

  987: 		} elsif($input =~ /^-?[\d.]+$/) {
  988: 			return $self->_mutate_num($input);

					

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

  989: 		} else {
  990: 			return $self->_mutate_string($input);

					

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

  991: 		}
  992: 	}
  993: 	elsif($type eq 'ARRAY') {
  994: 		return $self->_mutate_array($input);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  995: 	}
  996: 	elsif($type eq 'HASH') {
  997: 		return $self->_mutate_hash($input);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  998: 	}
  999: 
 1000: 	# Blessed refs and other types pass through unchanged
●1001 → 1001 → 0 1001: 	return $input;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1002: }
 1003: 
 1004: # --------------------------------------------------
 1005: # _mutate_int
 1006: #
 1007: # Purpose:    Apply a random arithmetic mutation to
 1008: #             an integer value.
 1009: #
 1010: # Entry:      $n - the integer to mutate.
 1011: # Exit:       Returns a mutated integer.
 1012: # Side effects: None.
 1013: # --------------------------------------------------
 1014: sub _mutate_int {
 1015: 	my ($self, $n) = @_;
 1016: 
 1017: 	my @ops = (
 1018: 		sub { $n + 1              },
 1019: 		sub { $n - 1              },
 1020: 		sub { $n * 2              },
 1021: 		sub { $n == 0 ? 1 : int($n / 2) },

					

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

 1022: 		sub { -$n                 },
 1023: 		sub { 0                   },
 1024: 		sub { $INT32_MAX          },
 1025: 		sub { $INT32_MIN          },
 1026: 	);
 1027: 
 1028: 	return $ops[ int(rand(@ops)) ]->();
 1029: }
 1030: 
 1031: # --------------------------------------------------
 1032: # _mutate_num
 1033: #
 1034: # Purpose:    Apply a random arithmetic mutation to
 1035: #             a floating point value.
 1036: #
 1037: # Entry:      $n - the number to mutate.
 1038: # Exit:       Returns a mutated number.
 1039: # Side effects: None.
 1040: # --------------------------------------------------
 1041: sub _mutate_num {
 1042: 	my ($self, $n) = @_;
 1043: 
 1044: 	my @ops = (
 1045: 		sub { $n + rand(10)        },
 1046: 		sub { $n - rand(10)        },
 1047: 		sub { $n * (1 + rand())    },
 1048: 		sub { 0                    },
 1049: 		sub { -$n                  },
 1050: 	);
 1051: 
 1052: 	return $ops[ int(rand(@ops)) ]->();
 1053: }
 1054: 
 1055: # --------------------------------------------------
 1056: # _mutate_string
 1057: #
 1058: # Purpose:    Apply a random structural mutation to
 1059: #             a string value — bit flip, insert,
 1060: #             delete, truncate, repeat, or replace
 1061: #             with an interesting known value.
 1062: #
 1063: # Entry:      $s - the string to mutate.
 1064: # Exit:       Returns a mutated string.
 1065: # Side effects: None.
 1066: # --------------------------------------------------
 1067: sub _mutate_string {
 1068: 	my ($self, $s) = @_;
 1069: 
 1070: 	my $len = length($s);
 1071: 
 1072: 	my @ops = (
 1073: 		# Bit flip a random character
 1074: 		sub {
 1075: 			return $s unless $len;

					

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

 1076: 			my $pos  = int(rand($len));
 1077: 			my $char = substr($s, $pos, 1);
 1078: 			substr($s, $pos, 1) = chr(ord($char) ^ (1 << int(rand(8))));
 1079: 			$s
 1080: 		},
 1081: 		# Insert a random byte
 1082: 		sub {
 1083: 			my $pos  = int(rand($len + 1));
 1084: 			my $char = chr(int(rand(256)));
 1085: 			substr($s, $pos, 0, $char);
 1086: 			$s
 1087: 		},
 1088: 		# Delete a random character
 1089: 		sub {
 1090: 			return $s unless $len;

					

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

 1091: 			substr($s, int(rand($len)), 1, '');
 1092: 			$s
 1093: 		},
 1094: 		# Truncate at a random position
 1095: 		sub { substr($s, 0, int(rand($len + 1))) },
 1096: 		# Double the string
 1097: 		sub { $s x 2 },
 1098: 		# Replace with a known interesting string
 1099: 		sub {
 1100: 			my @interesting = (
 1101: 				'', ' ', "\0", "\n", "\t",
 1102: 				'a' x 256,
 1103: 				'null', 'undefined',
 1104: 				"'; DROP TABLE foo; --",
 1105: 				'<script>alert(1)</script>',
 1106: 			);
 1107: 			$interesting[ int(rand(@interesting)) ]
 1108: 		},
 1109: 	);
 1110: 
 1111: 	return $ops[ int(rand(@ops)) ]->();
 1112: }
 1113: 
 1114: # --------------------------------------------------
 1115: # _mutate_array
 1116: #
 1117: # Purpose:    Apply a random structural mutation to
 1118: #             an arrayref — mutate element, duplicate,
 1119: #             delete, or empty.
 1120: #
 1121: # Entry:      $arr - the arrayref to mutate.
 1122: # Exit:       Returns a mutated arrayref copy.
 1123: # Side effects: None.
 1124: # --------------------------------------------------
 1125: sub _mutate_array {
 1126: 	my ($self, $arr) = @_;
 1127: 
 1128: 	my @copy = @{$arr};
 1129: 
 1130: 	my @ops = (
 1131: 		# Mutate a random element
 1132: 		sub {
 1133: 			return [] unless @copy;
 1134: 			my $i = int(rand(@copy));
 1135: 			$copy[$i] = $self->_mutate($copy[$i]);
 1136: 			\@copy
 1137: 		},
 1138: 		# Duplicate a random element
 1139: 		sub {
 1140: 			return \@copy unless @copy;
 1141: 			my $i = int(rand(@copy));
 1142: 			splice @copy, $i, 0, $copy[$i];
 1143: 			\@copy
 1144: 		},
 1145: 		# Delete a random element
 1146: 		sub {
 1147: 			return \@copy unless @copy;
 1148: 			splice @copy, int(rand(@copy)), 1;
 1149: 			\@copy
 1150: 		},
 1151: 		# Return empty array
 1152: 		sub { [] },
 1153: 	);
 1154: 
 1155: 	return $ops[ int(rand(@ops)) ]->();
 1156: }
 1157: 
 1158: # --------------------------------------------------
 1159: # _mutate_hash
 1160: #
 1161: # Purpose:    Apply a random mutation to one value
 1162: #             in a hashref copy.
 1163: #
 1164: # Entry:      $h - the hashref to mutate.
 1165: # Exit:       Returns a mutated hashref copy.
 1166: # Side effects: None.
 1167: # --------------------------------------------------
 1168: sub _mutate_hash {
 1169: 	my ($self, $h) = @_;
 1170: 
 1171: 	my %copy = %{$h};
 1172: 	my @keys = keys %copy;
 1173: 
 1174: 	# Return unchanged if hash is empty
 1175: 	return \%copy unless @keys;
 1176: 
 1177: 	my $k = $keys[ int(rand(@keys)) ];
 1178: 	$copy{$k} = $self->_mutate($copy{$k});
 1179: 
 1180: 	return \%copy;
 1181: }
 1182: 
 1183: # --------------------------------------------------
 1184: # _seed_corpus
 1185: #
 1186: # Purpose:    Pre-populate the corpus with a small
 1187: #             set of randomly generated inputs to
 1188: #             give the fuzzing loop a starting point.
 1189: #
 1190: # Entry:      None beyond $self.
 1191: # Exit:       Returns nothing. Appends to $self->{corpus}.
 1192: # Side effects: Modifies $self->{corpus}.
 1193: # --------------------------------------------------
 1194: sub _seed_corpus {
●1195 → 1197 → 0 1195: 	my $self = $_[0];
 1196: 
 1197: 	for (1 .. $SEED_CORPUS_SIZE) {
 1198: 		push @{ $self->{corpus} }, {
 1199: 			input    => $self->_generate_random(),
 1200: 			coverage => {},
 1201: 		};
 1202: 	}
 1203: }
 1204: 
 1205: # --------------------------------------------------
 1206: # _build_report
 1207: #
 1208: # Purpose:    Construct the summary report hashref
 1209: #             returned by run().
 1210: #
 1211: # Entry:      None beyond $self.
 1212: # Exit:       Returns a report hashref.
 1213: # Side effects: None.
 1214: # --------------------------------------------------
 1215: sub _build_report {
 1216: 	my $self = $_[0];
 1217: 
 1218: 	return {
 1219: 		total_iterations   => $self->{stats}{total},
 1220: 		interesting_inputs => $self->{stats}{interesting},
 1221: 		corpus_size        => scalar @{ $self->{corpus} },
 1222: 		branches_covered   => $self->{stats}{coverage},
 1223: 		bugs_found         => $self->{stats}{bugs},
 1224: 		bugs               => $self->{bugs},
 1225: 	};
 1226: }
 1227: 
 1228: =head1 AUTHOR
 1229: 
 1230: Nigel Horne, C<< <njh at nigelhorne.com> >>
 1231: 
 1232: Portions of this module's initial design and documentation were created
 1233: with the assistance of AI.
 1234: 
 1235: =head1 LICENCE AND COPYRIGHT
 1236: 
 1237: Copyright 2026 Nigel Horne.
 1238: 
 1239: Usage is subject to GPL2 licence terms.
 1240: If you use it,
 1241: please let me know.
 1242: 
 1243: =cut
 1244: 
 1245: 1;