lib/App/Test/Generator/Mutation/ConditionalInversion.pm

        start → end → jump
        

    1: package App::Test::Generator::Mutation::ConditionalInversion;
    2: 
    3: use strict;
    4: use warnings;
    5: use Carp qw(croak);
    6: use parent 'App::Test::Generator::Mutation::Base';
    7: use App::Test::Generator::Mutant;
    8: use PPI;
    9: 
   10: our $VERSION = '0.36';
   11: 
   12: =head1 VERSION
   13: 
   14: Version 0.36
   15: 
   16: =head1 METHODS
   17: 
   18: =head2 applies_to
   19: 
   20: Returns true if the document contains any C<if> or C<unless> compound
   21: statements that this mutator can target.
   22: 
   23: =cut
   24: 
   25: sub applies_to {
●26 → 28 → 34●26 → 28 → 0   26: 	my ($self, $doc) = @_;
   27: 	my $compounds = $doc->find('PPI::Statement::Compound') || [];
   28: 	for my $stmt (@{$compounds}) {
   29: 		my $first = $stmt->schild(0);
   30: 		next unless $first && $first->isa('PPI::Token::Word');
   31: 		my $type = $first->content();
   32: 		return 1 if $type eq 'if' || $type eq 'unless';
  Mutants (Total: 2, Killed: 2, Survived: 0)
   33: 	}
●34 → 34 → 0   34: 	return 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
   35: }
   36: 
   37: =head2 mutate
   38: 
   39: Walk a PPI document and generate one mutant for each C<if> or C<unless>
   40: statement, inverting the keyword to its opposite. This detects cases where
   41: the test suite does not exercise both branches of a conditional.
   42: 
   43:     my $mutation = App::Test::Generator::Mutation::ConditionalInversion->new;
   44:     my $doc      = PPI::Document->new(\$source);
   45:     my @mutants  = $mutation->mutate($doc);
   46: 
   47:     for my $m (@mutants) {
   48:         print $m->id, ': ', $m->description, "\n";
   49:     }
   50: 
   51: =head3 Arguments
   52: 
   53: =over 4
   54: 
   55: =item * C<$self>
   56: 
   57: An instance of C<App::Test::Generator::Mutation::ConditionalInversion>.
   58: 
   59: =item * C<$doc>
   60: 
   61: A L<PPI::Document> object representing the parsed source file to mutate.
   62: The document is not modified by this method.
   63: 
   64: =back
   65: 
   66: =head3 Returns
   67: 
   68: A list of L<App::Test::Generator::Mutant> objects, one per C<if> or
   69: C<unless> statement found in the document. Returns an empty list if no
   70: qualifying statements are found.
   71: 
   72: Each mutant carries a C<transform> closure that when called with a fresh
   73: L<PPI::Document> copy will flip the targeted keyword from C<if> to
   74: C<unless> or vice versa, targeting the exact statement by line and column
   75: number.
   76: 
   77: =head3 Notes
   78: 
   79: Multiple conditionals on the same source line are each mutated
   80: independently. Mutant IDs include both line and column number to ensure
   81: uniqueness.
   82: 
   83: =head3 API specification
   84: 
   85: =head4 input
   86: 
   87:     {
   88:         self => {
   89:             type => OBJECT,
   90:             isa  => 'App::Test::Generator::Mutation::ConditionalInversion',
   91:         },
   92:         doc => {
   93:             type => OBJECT,
   94:             isa  => 'PPI::Document',
   95:         },
   96:     }
   97: 
   98: =head4 output
   99: 
  100:     {
  101:         type     => ARRAYREF,
  102:         elements => {
  103:             type => OBJECT,
  104:             isa  => 'App::Test::Generator::Mutant',
  105:         },
  106:     }
  107: 
  108: =cut
  109: 
  110: sub mutate {
●111 → 117 → 177●111 → 117 → 0  111: 	my ($self, $doc) = @_;
  112: 
  113: 	# Find all compound statements in the document
  114: 	my $compounds = $doc->find('PPI::Statement::Compound') || [];
  115: 	my @mutants;
  116: 
  117: 	for my $stmt (@{$compounds}) {
  118: 		# Only process if and unless statements
  119: 		# Use the actual first token content rather than ->type() since
  120: 		# PPI >= 1.270 returns 'if' for both if and unless via ->type()
  121: 		my $first_word = $stmt->schild(0);
  122: 		next unless $first_word && $first_word->isa('PPI::Token::Word');
  123: 		my $type = $first_word->content();
  124: 		next unless $type eq 'if' || $type eq 'unless';
  125: 
  126: 		# Verify the statement has a condition block to invert
  127: 		my ($cond) = grep { $_->isa('PPI::Structure::Condition') } $stmt->children;
  128: 		next unless $cond;
  129: 
  130: 		# Capture location for precise targeting in the transform closure
  131: 		my $line = $stmt->location->[0];
  132: 		my $col  = $stmt->location->[1];
  133: 
  134: 		# Determine what the keyword flips to
  135: 		my $flipped = $type eq 'if' ? 'unless' : 'if';
  136: 
  137: 		my $mutant = eval {
  138: 			App::Test::Generator::Mutant->new(
  139: 				id          => "COND_INV_${line}_${col}",
  140: 				group       => "COND_INV:$line",
  141: 				description => "Invert condition $type to $flipped",
  142: 				line        => $line,
  143: 				type        => 'boolean',
  144: 				original    => $cond->content(),
  145: 
  146: 				# Closure captures line, col and flipped so it targets
  147: 				# exactly the right statement in the document copy
  148: 				transform   => sub {
  149: 					my ($doc) = @_;
  150: 					my $stmts = $doc->find('PPI::Statement::Compound') || [];
  151: 
  152: 					for my $stmt (@{$stmts}) {
  153: 						# Match by line and column to avoid mutating
  154: 						# the wrong conditional on the same line
  155: 						next unless $stmt->location->[0] == $line;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  156: 						next unless $stmt->location->[1] == $col;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  157: 
  158: 						# Flip the leading keyword
  159: 						my $first = $stmt->schild(0);
  160: 						next unless $first && $first->isa('PPI::Token::Word');
  161: 						$first->set_content($flipped);
  162: 						last;
  163: 					}
  164: 				},
  165: 			);
  166: 		};
  167: 
  168: 		# Report construction failures clearly rather than silently dropping
  169: 		if($@ || !$mutant) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  170: 			warn "Failed to construct mutant COND_INV_${line}_${col}: $@" if $@;
  171: 			next;
  172: 		}
  173: 
  174: 		push @mutants, $mutant;
  175: 	}
  176: 
●177 → 177 → 0  177: 	return @mutants;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  178: }
  179: 
  180: 1;