lib/App/Test/Generator/Mutator.pm

Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 91.67%
TER3 (LCSAJ): 100.0% (5/5)
Approximate LCSAJ segments: 49

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

start – first line of the linear sequence
end – last line before control flow changes
jump – line execution jumps to next

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::Mutator; 2: 3: use strict; 4: use warnings; 5: use Carp qw(croak); 6: use Config; 7: use File::Copy qw(copy); 8: use File::Copy::Recursive qw(dircopy); 9: use File::Spec; 10: use File::Temp qw(tempdir); 11: use PPI; 12: use Readonly; 13: 14: use App::Test::Generator::Mutation::BooleanNegation; 15: use App::Test::Generator::Mutation::ConditionalInversion; 16: use App::Test::Generator::Mutation::NumericBoundary; 17: use App::Test::Generator::Mutation::ReturnUndef; 18: 19: # -------------------------------------------------- 20: # Valid mutation level values 21: # -------------------------------------------------- 22: Readonly my $LEVEL_FULL => 'full'; 23: Readonly my $LEVEL_FAST => 'fast'; 24: 25: # -------------------------------------------------- 26: # Default values for optional constructor arguments 27: # -------------------------------------------------- 28: Readonly my $DEFAULT_LIB_DIR => 'lib'; 29: Readonly my $DEFAULT_MUTATION_LEVEL => $LEVEL_FULL; 30: 31: our $VERSION = '0.41'; 32: 33: =head1 NAME 34: 35: App::Test::Generator::Mutator - Generate and apply mutation tests 36: 37: =head1 VERSION 38: 39: Version 0.41 40: 41: =head1 DESCRIPTION 42: 43: B<App::Test::Generator::Mutator> is a mutation engine that programmatically 44: alters Perl source files to evaluate the effectiveness of a project's test 45: suite. It analyses modules, generates systematic code mutations (such as 46: conditional inversions, logical operator changes, and numeric boundary 47: flips), and applies them within an isolated workspace so tests can be 48: executed safely against each modified variant. 49: 50: By tracking which mutants are killed (cause tests to fail) versus those that 51: survive (tests still pass), the module enables calculation of a mutation 52: score, providing a quantitative measure of how well the test suite detects 53: unintended behavioural changes. 54: 55: =head2 new 56: 57: Construct a new Mutator for a given source file. 58: 59: my $mutator = App::Test::Generator::Mutator->new( 60: file => 'lib/My/Module.pm', 61: lib_dir => 'lib', 62: mutation_level => 'full', 63: ); 64: 65: =head3 Arguments 66: 67: =over 4 68: 69: =item * C<file> 70: 71: Path to the Perl source file to mutate. Required. Must exist on disk. 72: 73: =item * C<lib_dir> 74: 75: Root library directory. Optional - defaults to C<lib>. 76: 77: =item * C<mutation_level> 78: 79: Controls the breadth of mutation. C<full> applies all mutations; 80: C<fast> deduplicates and removes redundant mutants first. 81: Optional - defaults to C<full>. 82: 83: =back 84: 85: =head3 Returns 86: 87: A blessed hashref. Croaks if C<file> is missing or does not exist. 88: 89: =head3 API specification 90: 91: =head4 input 92: 93: { 94: file => { type => SCALAR }, 95: lib_dir => { type => SCALAR, optional => 1 }, 96: mutation_level => { type => SCALAR, optional => 1 }, 97: } 98: 99: =head4 output 100: 101: { 102: type => OBJECT, 103: isa => 'App::Test::Generator::Mutator', 104: } 105: 106: =cut 107: 108: sub new { 109: my ($class, %args) = @_; 110: 111: # file is required and must exist on disk 112: croak 'file required' unless defined $args{file}; 113: croak "file not found: $args{file}" unless -f $args{file}; 114: 115: return bless { 116: file => $args{file}, 117: lib_dir => $args{lib_dir} || $DEFAULT_LIB_DIR, 118: mutation_level => $args{mutation_level} || $DEFAULT_MUTATION_LEVEL, 119: 120: # Instantiate all registered mutation strategies 121: mutations => [ 122: App::Test::Generator::Mutation::BooleanNegation->new(), 123: App::Test::Generator::Mutation::ReturnUndef->new(), 124: App::Test::Generator::Mutation::NumericBoundary->new(), 125: App::Test::Generator::Mutation::ConditionalInversion->new(), 126: ], 127: }, $class; 128: } 129: 130: =head2 generate_mutants 131: 132: Parse the target file and generate all mutants by running each registered 133: mutation strategy against the PPI document. 134: 135: my @mutants = $mutator->generate_mutants(); 136: 137: =head3 Arguments 138: 139: None beyond C<$self>. 140: 141: =head3 Returns 142: 143: =head3 Returns 144: 145: A list of L<App::Test::Generator::Mutant> objects. In C<fast> mode, 146: redundant and duplicate mutants are removed before returning. 147: Lines within C<## MUTANT_SKIP_BEGIN> / C<## MUTANT_SKIP_END> annotation 148: blocks are excluded from the candidate list entirely. 149: After this method returns, 150: C<$self-E<gt>{skip_lines}> contains a hashref mapping excluded 151: line numbers to 1. 152: 153: =head3 API specification 154: 155: =head4 input 156: 157: { 158: self => { type => OBJECT, isa => 'App::Test::Generator::Mutator' }, 159: } 160: 161: =head4 output 162: 163: { 164: type => ARRAYREF, 165: elements => { type => OBJECT, isa => 'App::Test::Generator::Mutant' }, 166: } 167: 168: =cut 169: 170: sub generate_mutants { ●171 → 182 → 204 171: my $self = $_[0]; 172: 173: # Parse the target file into a PPI document 174: my $doc = PPI::Document->new($self->{file}) or croak "Unable to parse $self->{file}"; 175: 176: # Build set of lines excluded by ## MUTANT_SKIP_BEGIN / ## MUTANT_SKIP_END 177: my %skip_lines; 178: my $in_skip = 0; 179: my $skip_start = 0; 180: my $line_num = 0; 181: 182: for my $line (split /\n/, $doc->serialize()) { 183: $line_num++; 184: 185: # Match only lines where the annotation is the entire content â€” 186: # prevents false positives in comments or POD that mention the tag

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

188: croak "$self->{file}: MUTANT_SKIP_BEGIN at line $line_num with no prior MUTANT_SKIP_END" 189: if $in_skip; 190: $in_skip = 1; 191: $skip_start = $line_num; 192: } 193: $skip_lines{$line_num} = 1 if $in_skip; 194: 195: # Match only lines where the annotation is the entire content â€” 196: # prevents false positives in comments or POD that mention the tag 197: if($line =~ /^\s*##\s*MUTANT_SKIP_END\s*$/) {

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

198: croak "$self->{file}: MUTANT_SKIP_END at line $line_num with no matching MUTANT_SKIP_BEGIN" 199: unless $in_skip; 200: $in_skip = 0; 201: } 202: } 203: # Unclosed MUTANT_SKIP_BEGIN is fatal ●204 → 215 → 221 204: croak "$self->{file}: MUTANT_SKIP_BEGIN at line $skip_start has no matching MUTANT_SKIP_END" if $in_skip; 205: 206: # Store skip lines for use by the report generator 207: $self->{skip_lines} = \%skip_lines; 208: 209: my @mutants; 210: 211: # Run each registered mutation strategy against the document, 212: # excluding any candidates on skip-annotated lines. applies_to() 213: # is a cheap pre-filter -- skip the mutate() walk entirely for 214: # strategies that have nothing to match in this document. 215: for my $mutation (@{$self->{mutations}}) { 216: next unless $mutation->applies_to($doc); 217: push @mutants, grep { !$skip_lines{$_->line} } $mutation->mutate($doc); 218: }

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

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

219: 220: # In fast mode deduplicate and remove redundant mutants ●221 → 221 → 225 221: if($self->{mutation_level} eq $LEVEL_FAST) {