| File: | blib/lib/App/Test/Generator/Mutator.pm |
| Coverage: | 96.5% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Mutator; | |||||
| 2 | ||||||
| 3 | 15 15 | 161987 24 | use 5.036; | |||
| 4 | 15 15 15 | 1136 38553 54 | use autodie qw(:io); # covers open/close/read/write; excludes system (which legitimately fails) | |||
| 5 | 15 15 15 | 34221 10 398 | use Carp qw(croak); | |||
| 6 | 15 15 15 | 25 18 309 | use Config; | |||
| 7 | 15 15 15 | 3584 48684 508 | use File::Copy::Recursive qw(dircopy); | |||
| 8 | 15 15 15 | 41 12 142 | use File::Spec; | |||
| 9 | 15 15 15 | 875 13928 274 | use File::Temp qw(tempdir); | |||
| 10 | 15 15 15 | 2867 807218 253 | use PPI; | |||
| 11 | 15 15 15 | 735 4772 387 | use Readonly; | |||
| 12 | ||||||
| 13 | 15 15 15 | 3075 19 198 | use App::Test::Generator::Mutation::BooleanNegation; | |||
| 14 | 15 15 15 | 2140 20 172 | use App::Test::Generator::Mutation::ConditionalInversion; | |||
| 15 | 15 15 15 | 2119 21 169 | use App::Test::Generator::Mutation::NumericBoundary; | |||
| 16 | 15 15 15 | 2171 18 9460 | use App::Test::Generator::Mutation::ReturnUndef; | |||
| 17 | ||||||
| 18 | # -------------------------------------------------- | |||||
| 19 | # Valid mutation level values | |||||
| 20 | # -------------------------------------------------- | |||||
| 21 | Readonly my $LEVEL_FULL => 'full'; | |||||
| 22 | Readonly my $LEVEL_FAST => 'fast'; | |||||
| 23 | ||||||
| 24 | # -------------------------------------------------- | |||||
| 25 | # Default values for optional constructor arguments | |||||
| 26 | # -------------------------------------------------- | |||||
| 27 | Readonly my $DEFAULT_LIB_DIR => 'lib'; | |||||
| 28 | Readonly my $DEFAULT_MUTATION_LEVEL => $LEVEL_FULL; | |||||
| 29 | ||||||
| 30 | # -------------------------------------------------- | |||||
| 31 | # Error message constants â named so test code can | |||||
| 32 | # match against them without duplicating the literal | |||||
| 33 | # -------------------------------------------------- | |||||
| 34 | Readonly my $ERR_FILE_REQUIRED => 'file required'; | |||||
| 35 | Readonly my $ERR_WORKSPACE_NOT_SET => 'Workspace not prepared -- call prepare_workspace first'; | |||||
| 36 | Readonly my $ERR_RELATIVE_NOT_SET => 'Relative path not set -- call prepare_workspace first'; | |||||
| 37 | ||||||
| 38 | our $VERSION = '0.46'; | |||||
| 39 | ||||||
| 40 - 166 | =head1 NAME
App::Test::Generator::Mutator - Generate and apply mutation tests
=head1 VERSION
Version 0.46
=head1 SYNOPSIS
use App::Test::Generator::Mutator;
my $mutator = App::Test::Generator::Mutator->new(
file => 'lib/My/Module.pm',
lib_dir => 'lib',
mutation_level => 'fast',
);
my $mutants = $mutator->generate_mutants();
printf "Generated %d mutants\n", scalar @{$mutants};
my $workspace = $mutator->prepare_workspace();
for my $m (@{$mutants}) {
$mutator->apply_mutant($m);
if($mutator->run_tests()) {
print "SURVIVED: ${\$m->description}\n";
} else {
print "KILLED: ${\$m->description}\n";
}
}
=head1 DESCRIPTION
B<App::Test::Generator::Mutator> is a mutation engine that programmatically
alters Perl source files to evaluate the effectiveness of a project's test
suite. It analyses modules, generates systematic code mutations (such as
conditional inversions, logical operator changes, and numeric boundary
flips), and applies them within an isolated workspace so tests can be
executed safely against each modified variant.
By tracking which mutants are killed (cause tests to fail) versus those that
survive (tests still pass), the module enables calculation of a mutation
score, providing a quantitative measure of how well the test suite detects
unintended behavioural changes.
=head2 new
Construct a new Mutator for a given source file.
my $mutator = App::Test::Generator::Mutator->new(
file => 'lib/My/Module.pm',
lib_dir => 'lib',
mutation_level => 'full',
);
=head3 Arguments
=over 4
=item * C<file>
Path to the Perl source file to mutate. Required. Must exist on disk.
=item * C<lib_dir>
Root library directory. Optional - defaults to C<lib>.
=item * C<mutation_level>
Controls the breadth of mutation. C<full> applies all mutations;
C<fast> deduplicates and removes redundant mutants first.
Optional - defaults to C<full>.
=back
=head3 Returns
A blessed hashref. Croaks if C<file> is missing or does not exist.
=head3 API specification
=head4 input
{
file => { type => SCALAR },
lib_dir => { type => SCALAR, optional => 1 },
mutation_level => { type => SCALAR, optional => 1 },
}
=head4 output
{
type => OBJECT,
isa => 'App::Test::Generator::Mutator',
}
=head3 EXAMPLE
my $m = App::Test::Generator::Mutator->new(
file => 'lib/Acme/Widget.pm',
mutation_level => 'fast',
);
=head3 MESSAGES
=over 4
=item C<file required>
C<file> was not supplied.
=item C<< file not found: PATH >>
C<file> was supplied but does not exist on disk.
=back
=head3 FORMAL SPECIFICATION
Pre: C<file> is defined â§ C<-f file>
Post: C<ref(result) eq 'App::Test::Generator::Mutator'>
â§ C<result-E<gt>{file} eq file>
â§ C<result-E<gt>{mutation_level} â {full, fast}>
=cut | |||||
| 167 | ||||||
| 168 | sub new { | |||||
| 169 | 125 | 708952 | my ($class, %args) = @_; | |||
| 170 | ||||||
| 171 | # file is required and must exist on disk | |||||
| 172 | 125 | 470 | croak $ERR_FILE_REQUIRED unless defined $args{file}; | |||
| 173 | 119 | 890 | croak "file not found: $args{file}" unless -f $args{file}; | |||
| 174 | ||||||
| 175 | return bless { | |||||
| 176 | file => $args{file}, | |||||
| 177 | lib_dir => $args{lib_dir} || $DEFAULT_LIB_DIR, | |||||
| 178 | 113 | 977 | mutation_level => $args{mutation_level} || $DEFAULT_MUTATION_LEVEL, | |||
| 179 | ||||||
| 180 | # Instantiate all registered mutation strategies | |||||
| 181 | mutations => [ | |||||
| 182 | App::Test::Generator::Mutation::BooleanNegation->new(), | |||||
| 183 | App::Test::Generator::Mutation::ReturnUndef->new(), | |||||
| 184 | App::Test::Generator::Mutation::NumericBoundary->new(), | |||||
| 185 | App::Test::Generator::Mutation::ConditionalInversion->new(), | |||||
| 186 | ], | |||||
| 187 | }, $class; | |||||
| 188 | } | |||||
| 189 | ||||||
| 190 - 281 | =head2 generate_mutants
Parse the target file and generate all mutants by running each registered
mutation strategy against the PPI document.
my $mutants = $mutator->generate_mutants(); # scalar context â arrayref
for my $m (@{$mutants}) { ... }
my @mutants = $mutator->generate_mutants(); # list context â flat list (backward-compat)
=head3 Arguments
None beyond C<$self>.
=head3 Returns
An arrayref of L<App::Test::Generator::Mutant> objects. In C<fast> mode,
redundant and duplicate mutants are removed before returning.
Lines within C<## MUTANT_SKIP_BEGIN> / C<## MUTANT_SKIP_END> annotation
blocks are excluded from the candidate list entirely.
After this method returns,
C<$self-E<gt>{skip_lines}> contains a hashref mapping excluded
line numbers to 1.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutator' },
}
=head4 output
{
type => ARRAYREF,
elements => { type => OBJECT, isa => 'App::Test::Generator::Mutant' },
}
=head3 EXAMPLE
my $mutants = $mutator->generate_mutants();
printf "%d mutants generated\n", scalar @{$mutants};
for my $m (@{$mutants}) {
printf "line %d: %s\n", $m->line, $m->description;
}
=head3 MESSAGES
=over 4
=item C<< Unable to parse FILE >>
PPI could not parse the source file (syntax error or unreadable file).
FILE is the path passed to C<new>.
=item C<< FILE: MUTANT_SKIP_BEGIN at line N with no prior MUTANT_SKIP_END >>
A C<## MUTANT_SKIP_BEGIN> marker was found while already inside a skip block.
=item C<< FILE: MUTANT_SKIP_END at line N with no matching MUTANT_SKIP_BEGIN >>
A C<## MUTANT_SKIP_END> marker was found with no preceding C<## MUTANT_SKIP_BEGIN>.
=item C<< FILE: MUTANT_SKIP_BEGIN at line N has no matching MUTANT_SKIP_END >>
The source file ended while still inside a skip block.
=back
=head3 FORMAL SPECIFICATION
Pre: C<prepare_workspace> need not have been called before this method.
Post: C<ref(result) eq 'ARRAY'>
â§ C<â m â result: ref(m) eq 'App::Test::Generator::Mutant'>
â§ C<â m â result: ¬ skip_lines{m->line}>
=head3 PSEUDOCODE
parse file with PPI
scan lines for MUTANT_SKIP_BEGIN / MUTANT_SKIP_END pairs â skip_lines
for each registered mutation strategy:
skip if strategy does not apply_to(doc)
for each mutant from strategy->mutate(doc):
include unless mutant.line â skip_lines
if mutation_level == 'fast':
deduplicate and remove redundant mutants
return arrayref (or flat list in list context)
=cut | |||||
| 282 | ||||||
| 283 | sub generate_mutants { | |||||
| 284 | 71 | 30235 | my $self = $_[0]; | |||
| 285 | ||||||
| 286 | # Parse the target file into a PPI document | |||||
| 287 | 71 | 524 | my $doc = PPI::Document->new($self->{file}) or croak "Unable to parse $self->{file}"; | |||
| 288 | ||||||
| 289 | # Build set of lines excluded by ## MUTANT_SKIP_BEGIN / ## MUTANT_SKIP_END | |||||
| 290 | 71 | 437366 | my %skip_lines; | |||
| 291 | 71 | 117 | my $in_skip = 0; | |||
| 292 | 71 | 74 | my $skip_start = 0; | |||
| 293 | 71 | 101 | my $line_num = 0; | |||
| 294 | ||||||
| 295 | 71 | 212 | for my $line (split /\n/, $doc->serialize()) { | |||
| 296 | 1841 | 39107 | $line_num++; | |||
| 297 | ||||||
| 298 | # Match only lines where the annotation is the entire content â | |||||
| 299 | # prevents false positives in comments or POD that mention the tag | |||||
| 300 | 1841 | 1398 | if($line =~ /^\s*##\s*MUTANT_SKIP_BEGIN\s*$/) { | |||
| 301 | 10 | 37 | croak "$self->{file}: MUTANT_SKIP_BEGIN at line $line_num with no prior MUTANT_SKIP_END" | |||
| 302 | if $in_skip; | |||||
| 303 | 8 | 18 | $in_skip = 1; | |||
| 304 | 8 | 7 | $skip_start = $line_num; | |||
| 305 | } | |||||
| 306 | 1839 | 1240 | $skip_lines{$line_num} = 1 if $in_skip; | |||
| 307 | ||||||
| 308 | # Match only lines where the annotation is the entire content â | |||||
| 309 | # prevents false positives in comments or POD that mention the tag | |||||
| 310 | 1839 | 1455 | if($line =~ /^\s*##\s*MUTANT_SKIP_END\s*$/) { | |||
| 311 | 6 | 36 | croak "$self->{file}: MUTANT_SKIP_END at line $line_num with no matching MUTANT_SKIP_BEGIN" | |||
| 312 | unless $in_skip; | |||||
| 313 | 3 | 4 | $in_skip = 0; | |||
| 314 | } | |||||
| 315 | } | |||||
| 316 | # Unclosed MUTANT_SKIP_BEGIN is fatal | |||||
| 317 | 66 | 216 | croak "$self->{file}: MUTANT_SKIP_BEGIN at line $skip_start has no matching MUTANT_SKIP_END" if $in_skip; | |||
| 318 | ||||||
| 319 | # Store skip lines for use by the report generator | |||||
| 320 | 63 | 148 | $self->{skip_lines} = \%skip_lines; | |||
| 321 | ||||||
| 322 | 63 | 68 | my @mutants; | |||
| 323 | ||||||
| 324 | # Run each registered mutation strategy against the document, | |||||
| 325 | # excluding any candidates on skip-annotated lines. applies_to() | |||||
| 326 | # is a cheap pre-filter -- skip the mutate() walk entirely for | |||||
| 327 | # strategies that have nothing to match in this document. | |||||
| 328 | 63 63 | 77 116 | for my $mutation (@{$self->{mutations}}) { | |||
| 329 | 252 | 848 | next unless $mutation->applies_to($doc); | |||
| 330 | 194 795 | 487 783 | push @mutants, grep { !$skip_lines{$_->line} } $mutation->mutate($doc); | |||
| 331 | } | |||||
| 332 | ||||||
| 333 | # In fast mode deduplicate and remove redundant mutants before returning. | |||||
| 334 | # Returns arrayref in scalar context and a flat list in list context so | |||||
| 335 | # existing callers (my @m = generate_mutants()) continue to work unchanged. | |||||
| 336 | 63 | 334 | my $result = $self->{mutation_level} eq $LEVEL_FAST | |||
| 337 | ? _dedup_mutants(\@mutants) | |||||
| 338 | : \@mutants; | |||||
| 339 | ||||||
| 340 | 63 52 | 406 203 | return wantarray ? @{$result} : $result; | |||
| 341 | } | |||||
| 342 | ||||||
| 343 - 420 | =head2 prepare_workspace
Prepare an isolated temporary workspace for a single mutation test run.
The entire C<lib_dir> tree is copied into the workspace so that all module
dependencies resolve correctly when the test suite runs against the mutant.
Only after this copy is complete is the single target file overwritten by
C<apply_mutant>.
my $workspace = $mutator->prepare_workspace();
$mutator->apply_mutant($mutant);
local $ENV{PERL5LIB} = "$workspace/lib";
my $survived = (system('prove', 't') == 0);
=head3 Arguments
None beyond C<$self>.
=head3 Returns
A string containing the absolute path to the temporary directory created.
The directory is automatically removed when the object goes out of scope
via L<File::Temp>'s C<CLEANUP =E<gt> 1> behaviour.
=head3 Side effects
Creates a temporary directory. Recursively copies C<lib_dir> into it.
Sets C<< $self->{_workspace} >>, C<< $self->{_relative} >>, and
C<< $self->{_lib_basename} >>. Does not modify C<< $self->{lib_dir} >>.
=head3 Notes
Call C<prepare_workspace> once per file, then C<apply_mutant> once per
mutant within that file. Do not store the returned path beyond the
lifetime of the enclosing scope.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutator' },
}
=head4 output
{
type => SCALAR,
}
=head3 EXAMPLE
my $workspace = $mutator->prepare_workspace();
# workspace is an absolute temp dir path
# original lib_dir value is unchanged
printf "original lib_dir still: %s\n", $mutator->{lib_dir};
=head3 MESSAGES
=over 4
=item C<dircopy failed: $!>
The C<lib_dir> tree could not be copied into the temporary workspace directory,
usually a permissions error.
=back
=head3 FORMAL SPECIFICATION
Pre: C<-d self-E<gt>{lib_dir}>
â§ C<self-E<gt>{file}> begins with C<self-E<gt>{lib_dir}>
Post: C<-d result>
â§ C<self-E<gt>{_workspace} eq result>
â§ C<self-E<gt>{lib_dir}> unchanged
=cut | |||||
| 421 | ||||||
| 422 | sub prepare_workspace { | |||||
| 423 | 17 | 10944 | my $self = $_[0]; | |||
| 424 | ||||||
| 425 | # Create a self-cleaning temporary directory | |||||
| 426 | 17 | 124 | my $tmp = tempdir(CLEANUP => 1); | |||
| 427 | ||||||
| 428 | # Normalise lib_dir to its final component so workspace paths | |||||
| 429 | # are relative regardless of whether an absolute path was passed in | |||||
| 430 | 17 | 4635 | my $lib_basename = (File::Spec->splitdir($self->{lib_dir}))[-1]; | |||
| 431 | ||||||
| 432 | # Derive the file's path relative to lib_dir for use by apply_mutant | |||||
| 433 | 17 | 34 | my $relative = $self->{file}; | |||
| 434 | 17 | 238 | $relative =~ s/^\Q$self->{lib_dir}\E\/?//; | |||
| 435 | ||||||
| 436 | # Copy the entire lib tree so all dependencies resolve in the workspace | |||||
| 437 | 17 | 176 | dircopy($self->{lib_dir}, File::Spec->catfile($tmp, $lib_basename)) or croak "dircopy failed: $!"; | |||
| 438 | ||||||
| 439 | # Store normalised state under private keys â do NOT mutate lib_dir, | |||||
| 440 | # which callers may inspect after this call expecting the original value. | |||||
| 441 | 16 | 25994 | $self->{_workspace} = $tmp; | |||
| 442 | 16 | 41 | $self->{_relative} = $relative; | |||
| 443 | 16 | 28 | $self->{_lib_basename} = $lib_basename; | |||
| 444 | ||||||
| 445 | 16 | 45 | return $tmp; | |||
| 446 | } | |||||
| 447 | ||||||
| 448 - 519 | =head2 apply_mutant
Apply a single mutant's transform to the target file in the workspace.
$mutator->apply_mutant($mutant);
=head3 Arguments
=over 4
=item * C<$mutant>
An L<App::Test::Generator::Mutant> object whose C<transform> closure
will be applied to the workspace copy of the target file.
=back
=head3 Returns
Nothing. Modifies the workspace copy of the target file in place.
=head3 Side effects
Overwrites the target file in the workspace with the mutated version.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutator' },
mutant => { type => OBJECT, isa => 'App::Test::Generator::Mutant' },
}
=head4 output
{ type => UNDEF }
=head3 EXAMPLE
$mutator->prepare_workspace();
for my $m (@{$mutants}) {
$mutator->apply_mutant($m);
# workspace file is now mutated; run tests against it
}
=head3 MESSAGES
=over 4
=item C<Workspace not prepared -- call prepare_workspace first>
C<apply_mutant> was called before C<prepare_workspace>.
=item C<Relative path not set -- call prepare_workspace first>
Internal: the relative-path field was not set by C<prepare_workspace>.
=item C<< Failed to parse TARGET >>
PPI could not parse the workspace copy of the target file.
=back
=head3 FORMAL SPECIFICATION
Pre: C<self-E<gt>{_workspace}> is defined â§ C<self-E<gt>{_relative}> is defined
â§ C<ref(mutant-E<gt>{transform}) eq 'CODE'>
Post: workspace copy of target file contains the mutated content
=cut | |||||
| 520 | ||||||
| 521 | sub apply_mutant { | |||||
| 522 | 14 | 1070 | my ($self, $mutant) = @_; | |||
| 523 | ||||||
| 524 | # Workspace must be prepared before applying any mutant | |||||
| 525 | my $workspace = $self->{_workspace} | |||||
| 526 | 14 | 233 | or croak $ERR_WORKSPACE_NOT_SET; | |||
| 527 | ||||||
| 528 | my $relative = $self->{_relative} | |||||
| 529 | 6 | 20 | or croak $ERR_RELATIVE_NOT_SET; | |||
| 530 | ||||||
| 531 | # Construct the full path to the file in the workspace | |||||
| 532 | my $target = File::Spec->catfile( | |||||
| 533 | $workspace, | |||||
| 534 | $self->{_lib_basename}, | |||||
| 535 | 6 | 42 | $relative, | |||
| 536 | ); | |||||
| 537 | ||||||
| 538 | # Parse the workspace copy and apply the mutation transform | |||||
| 539 | 6 | 59 | my $doc = PPI::Document->new($target) or croak "Failed to parse $target"; | |||
| 540 | ||||||
| 541 | 6 | 29809 | $mutant->transform->($doc); | |||
| 542 | ||||||
| 543 | 6 | 185 | $doc->save($target); | |||
| 544 | } | |||||
| 545 | ||||||
| 546 - 597 | =head2 run_tests
Run the test suite against the current workspace and return whether all
tests passed.
my $survived = $mutator->run_tests();
=head3 Arguments
None beyond C<$self>.
=head3 Returns
1 if all tests passed (mutant survived), 0 if any test failed (mutant
killed).
=head3 Side effects
Executes an external process running the test suite.
=head3 Notes
Uses C<prove> found on PATH. Sets C<PERL5LIB> to include the workspace
lib directory before running.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutator' },
}
=head4 output
{ type => SCALAR }
=head3 EXAMPLE
my $survived = $mutator->run_tests();
if($survived) {
print "mutant survived\n";
} else {
print "mutant killed\n";
}
=head3 FORMAL SPECIFICATION
Post: C<result â {0, 1}>
⧠C<result == 1> ⺠all tests in C<t/> passed against current C<lib/>
=cut | |||||
| 598 | ||||||
| 599 | sub run_tests { | |||||
| 600 | 6 | 1002 | my $self = $_[0]; | |||
| 601 | ||||||
| 602 | # Derive prove from $^X so CPAN smokers that install to a non-PATH | |||||
| 603 | # location still resolve the correct perl/prove pair. Config{bin} | |||||
| 604 | # is a reliable fallback; bare 'prove' is last resort only. | |||||
| 605 | 6 | 92 | my ($vol, $dir) = File::Spec->splitpath($^X); | |||
| 606 | 6 | 48 | my $prove = File::Spec->catpath($vol, $dir, 'prove'); | |||
| 607 | 6 | 54 | $prove = File::Spec->catfile($Config{bin}, 'prove') unless -x $prove; | |||
| 608 | 6 | 42 | $prove = 'prove' unless -x $prove; | |||
| 609 | ||||||
| 610 | 6 | 1043269 | return system($prove, '-l', 't') == 0; | |||
| 611 | } | |||||
| 612 | ||||||
| 613 | # -------------------------------------------------- | |||||
| 614 | # _dedup_mutants | |||||
| 615 | # | |||||
| 616 | # Purpose: Remove duplicate and redundant mutants | |||||
| 617 | # from a list, used in fast mutation mode | |||||
| 618 | # to reduce the number of mutants to run. | |||||
| 619 | # | |||||
| 620 | # Entry: $mutants - arrayref of Mutant objects. | |||||
| 621 | # | |||||
| 622 | # Exit: Returns an arrayref of deduplicated | |||||
| 623 | # Mutant objects. | |||||
| 624 | # | |||||
| 625 | # Side effects: None. | |||||
| 626 | # | |||||
| 627 | # Notes: Deduplication key uses line, original, | |||||
| 628 | # and description rather than the transform | |||||
| 629 | # coderef, which is not stable as a string. | |||||
| 630 | # -------------------------------------------------- | |||||
| 631 | sub _dedup_mutants { | |||||
| 632 | 38 | 2760 | my ($mutants) = @_; | |||
| 633 | 38 | 45 | my @rc; | |||
| 634 | my %seen; | |||||
| 635 | ||||||
| 636 | 38 38 | 36 61 | for my $m (@{$mutants}) { | |||
| 637 | # Build a stable key from metadata â not from the coderef | |||||
| 638 | 194 | 196 | my $key = join '|', | |||
| 639 | $m->line // '', | |||||
| 640 | $m->original // '', | |||||
| 641 | $m->description // ''; | |||||
| 642 | ||||||
| 643 | 194 | 292 | next if $seen{$key}++; | |||
| 644 | 187 | 157 | next if _is_redundant_mutation($m); | |||
| 645 | ||||||
| 646 | 175 | 147 | push @rc, $m; | |||
| 647 | } | |||||
| 648 | ||||||
| 649 | 38 | 73 | return \@rc; | |||
| 650 | } | |||||
| 651 | ||||||
| 652 | # -------------------------------------------------- | |||||
| 653 | # _is_redundant_mutation | |||||
| 654 | # | |||||
| 655 | # Return true if a mutant is considered | |||||
| 656 | # redundant and should be skipped in fast | |||||
| 657 | # mutation mode. | |||||
| 658 | # | |||||
| 659 | # Entry: $m - a Mutant object. | |||||
| 660 | # | |||||
| 661 | # Exit: Returns 1 if redundant, 0 otherwise. | |||||
| 662 | # | |||||
| 663 | # Notes: Checks for arithmetic no-ops, double | |||||
| 664 | # negation inside conditionals, boolean | |||||
| 665 | # literal flips, mutations inside comments, | |||||
| 666 | # and equivalent numeric comparisons. | |||||
| 667 | # Does not compare transform coderefs â | |||||
| 668 | # they are not meaningful as strings. | |||||
| 669 | # -------------------------------------------------- | |||||
| 670 | sub _is_redundant_mutation { | |||||
| 671 | 216 | 190 | my ($m) = @_; | |||
| 672 | ||||||
| 673 | 216 | 183 | my $orig = $m->original // ''; | |||
| 674 | ||||||
| 675 | # Arithmetic no-ops add nothing to mutation coverage | |||||
| 676 | 216 | 235 | return 1 if $orig =~ /\+\s*0$/; | |||
| 677 | 209 | 223 | return 1 if $orig =~ /-\s*0$/; | |||
| 678 | ||||||
| 679 | # Double negation inside conditionals forces boolean context | |||||
| 680 | # in Perl and is not a meaningful mutation | |||||
| 681 | 203 | 208 | if($m->context && $m->context eq 'conditional') { | |||
| 682 | 58 | 66 | return 1 if $orig =~ /^\!\!/; | |||
| 683 | } | |||||
| 684 | ||||||
| 685 | # Boolean literal flip on a standalone 1 or 0 is trivial | |||||
| 686 | 200 | 266 | return 1 if $orig =~ /^\s*(?:1|0)\s*$/; | |||
| 687 | ||||||
| 688 | # Mutations inside comments are unreachable code | |||||
| 689 | 189 | 167 | return 1 if $m->line_content && $m->line_content =~ /^\s*#/; | |||
| 690 | ||||||
| 691 | 185 | 200 | return 0; | |||
| 692 | } | |||||
| 693 | ||||||
| 694 - 781 | =head1 COMMON PITFALLS
=over 4
=item Calling C<apply_mutant> before C<prepare_workspace>
C<apply_mutant> requires C<prepare_workspace> to have been called first. The
workspace holds the isolated copy of C<lib/> that receives mutations.
=item Passing an absolute path as C<lib_dir>
C<lib_dir> must be a B<relative> path (e.g. C<lib>). An absolute path causes
C<apply_mutant> to construct a doubled directory under the workspace and then
fail to find the target file.
=item Checking C<< $mutator->{workspace} >> after the refactor
Internal workspace state is stored in C<_workspace>, C<_relative>, and
C<_lib_basename> (note the underscore prefix). The original C<lib_dir> value
is never overwritten. Old code that reads C<< $mutator->{workspace} >> or
C<< $mutator->{relative} >> (without underscores) will not find these keys.
=item Forgetting that C<run_tests> drives C<prove> from C<$^X>
C<run_tests> resolves C<prove> from the same Perl binary used to run the script.
If you shell out to C<prove> directly in your own integration code, make sure
you are using the matching C<prove>.
=item C<generate_mutants> in list vs scalar context
C<generate_mutants> returns a flat list in list context and an arrayref in
scalar context. Assign to an arrayref (C<my $m = $mutator-E<gt>generate_mutants()>)
to guarantee you always get a reference regardless of calling context.
=back
=head1 LIMITATIONS
=over 4
=item * Single strategy registry
The four built-in mutation strategies are hardcoded in C<new>. There is no
plugin mechanism for registering additional strategies without subclassing.
A future version should accept a C<strategies> arrayref argument.
=item * No parallelism
C<run_tests> is synchronous. For large test suites or large mutant sets,
wall-clock time scales linearly. The in-place mutation strategy also
serialises all mutants behind a single file lock.
=item * PPI re-parse per apply_mutant call
C<apply_mutant> re-parses the workspace copy of the target file for every
mutant. For very large single-file modules the PPI parse time may dominate.
=item * apply_mutant does not restore on abnormal exit
If the process is killed between the write and restore in
C<bin/test-generator-mutate>, the project file is left mutated.
A C<git restore lib/...> recovers it.
=back
=head1 SEE ALSO
=over 4
=item C<bin/test-generator-mutate>
=item L<Devel::Mutator>
=back
=head1 AUTHOR
Nigel Horne, C<< <njh at nigelhorne.com> >>
=head1 LICENCE AND COPYRIGHT
Copyright 2026 Nigel Horne.
Usage is subject to the terms of GPL2.
If you use it,
please let me know.
=cut | |||||
| 782 | ||||||
| 783 | 1; | |||||