File Coverage

File:blib/lib/App/Test/Generator/Mutation/ConditionalInversion.pm
Coverage:81.6%

linestmtbrancondsubtimecode
1package App::Test::Generator::Mutation::ConditionalInversion;
2
3
9
9
9
9
137687
12
112
use strict;
4
9
9
9
9
16
6
166
use warnings;
5
9
9
9
9
19
10
162
use Carp qw(croak);
6
9
9
9
9
15
7
19
use parent 'App::Test::Generator::Mutation::Base';
7
9
9
9
9
415
15
87
use App::Test::Generator::Mutant;
8
9
9
9
9
13
9
2636
use PPI;
9
10our $VERSION = '0.36';
11
12 - 23
=head1 VERSION

Version 0.36

=head1 METHODS

=head2 applies_to

Returns true if the document contains any C<if> or C<unless> compound
statements that this mutator can target.

=cut
24
25sub applies_to {
26
5
5
3711
        my ($self, $doc) = @_;
27
5
100
7
        my $compounds = $doc->find('PPI::Statement::Compound') || [];
28
5
5
1319
6
        for my $stmt (@{$compounds}) {
29
2
3
                my $first = $stmt->schild(0);
30
2
50
33
15
                next unless $first && $first->isa('PPI::Token::Word');
31
2
3
                my $type = $first->content();
32
2
50
67
9
                return 1 if $type eq 'if' || $type eq 'unless';
33        }
34
3
10
        return 0;
35}
36
37 - 108
=head2 mutate

Walk a PPI document and generate one mutant for each C<if> or C<unless>
statement, inverting the keyword to its opposite. This detects cases where
the test suite does not exercise both branches of a conditional.

    my $mutation = App::Test::Generator::Mutation::ConditionalInversion->new;
    my $doc      = PPI::Document->new(\$source);
    my @mutants  = $mutation->mutate($doc);

    for my $m (@mutants) {
        print $m->id, ': ', $m->description, "\n";
    }

=head3 Arguments

=over 4

=item * C<$self>

An instance of C<App::Test::Generator::Mutation::ConditionalInversion>.

=item * C<$doc>

A L<PPI::Document> object representing the parsed source file to mutate.
The document is not modified by this method.

=back

=head3 Returns

A list of L<App::Test::Generator::Mutant> objects, one per C<if> or
C<unless> statement found in the document. Returns an empty list if no
qualifying statements are found.

Each mutant carries a C<transform> closure that when called with a fresh
L<PPI::Document> copy will flip the targeted keyword from C<if> to
C<unless> or vice versa, targeting the exact statement by line and column
number.

=head3 Notes

Multiple conditionals on the same source line are each mutated
independently. Mutant IDs include both line and column number to ensure
uniqueness.

=head3 API specification

=head4 input

    {
        self => {
            type => OBJECT,
            isa  => 'App::Test::Generator::Mutation::ConditionalInversion',
        },
        doc => {
            type => OBJECT,
            isa  => 'PPI::Document',
        },
    }

=head4 output

    {
        type     => ARRAYREF,
        elements => {
            type => OBJECT,
            isa  => 'App::Test::Generator::Mutant',
        },
    }

=cut
109
110sub mutate {
111
47
47
34232
        my ($self, $doc) = @_;
112
113        # Find all compound statements in the document
114
47
100
67
        my $compounds = $doc->find('PPI::Statement::Compound') || [];
115
47
50170
        my @mutants;
116
117
47
47
39
68
        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
84
80
                my $first_word = $stmt->schild(0);
122
84
50
33
530
                next unless $first_word && $first_word->isa('PPI::Token::Word');
123
84
83
                my $type = $first_word->content();
124
84
100
100
162
                next unless $type eq 'if' || $type eq 'unless';
125
126                # Verify the statement has a condition block to invert
127
81
330
99
511
                my ($cond) = grep { $_->isa('PPI::Structure::Condition') } $stmt->children;
128
81
50
94
                next unless $cond;
129
130                # Capture location for precise targeting in the transform closure
131
81
82
                my $line = $stmt->location->[0];
132
81
5841
                my $col  = $stmt->location->[1];
133
134                # Determine what the keyword flips to
135
81
100
514
                my $flipped = $type eq 'if' ? 'unless' : 'if';
136
137
81
52
                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
5
5
5
                                        my ($doc) = @_;
150
5
50
6
                                        my $stmts = $doc->find('PPI::Statement::Compound') || [];
151
152
5
5
2376
5
                                        for my $stmt (@{$stmts}) {
153                                                # Match by line and column to avoid mutating
154                                                # the wrong conditional on the same line
155
6
100
501
                                                next unless $stmt->location->[0] == $line;
156
5
50
1392
                                                next unless $stmt->location->[1] == $col;
157
158                                                # Flip the leading keyword
159
5
34
                                                my $first = $stmt->schild(0);
160
5
50
33
36
                                                next unless $first && $first->isa('PPI::Token::Word');
161
5
8
                                                $first->set_content($flipped);
162
5
13
                                                last;
163                                        }
164                                },
165
81
145
                        );
166                };
167
168                # Report construction failures clearly rather than silently dropping
169
81
50
33
123
                if($@ || !$mutant) {
170
0
0
0
                        warn "Failed to construct mutant COND_INV_${line}_${col}: $@" if $@;
171
0
0
                        next;
172                }
173
174
81
82
                push @mutants, $mutant;
175        }
176
177
47
85
        return @mutants;
178}
179
1801;