File Coverage

File:blib/lib/App/Test/Generator/Mutation/NumericBoundary.pm
Coverage:74.0%

linestmtbrancondsubtimecode
1package App::Test::Generator::Mutation::NumericBoundary;
2
3
10
10
10
270013
8
149
use strict;
4
10
10
10
14
7
201
use warnings;
5
10
10
10
16
8
181
use Carp qw(croak);
6
10
10
10
22
9
21
use parent 'App::Test::Generator::Mutation::Base';
7
10
10
10
522
12
87
use App::Test::Generator::Mutant;
8
10
10
10
16
7
2587
use PPI;
9
10our $VERSION = '0.36';
11
12 - 16
=head1 VERSION

Version 0.36

=cut
17
18# --------------------------------------------------
19# Mapping of each comparison operator to the list of
20# operators it should be flipped to when mutating.
21# Both directions are covered so that e.g. != can be
22# mutated to == and vice versa.
23# --------------------------------------------------
24my %FLIP = (
25        '>'  => [ '<', '>=', '<=' ],
26        '<'  => [ '>', '<=', '>=' ],
27        '>=' => [ '>', '<',  '<=' ],
28        '<=' => [ '<', '>',  '>=' ],
29        '==' => [ '!=' ],
30        '!=' => [ '==' ],
31);
32
33 - 39
=head2 applies_to

Returns true if the document contains any comparison operators that this
mutator can target (C<E<gt>>, C<E<lt>>, C<E<gt>=>, C<E<lt>=>, C<==>,
C<!=>).

=cut
40
41sub applies_to {
42
7
6001
        my ($self, $doc) = @_;
43
7
12
        my $ops = $doc->find('PPI::Token::Operator') || [];
44
7
7
1903
9
        for my $op (@{$ops}) {
45
5
8
                next unless exists $FLIP{$op->content()};
46
3
9
                my $next_sib = $op->next_sibling();
47
3
51
                next if $next_sib && $next_sib->isa('PPI::Token::Symbol');
48
3
4
                my $parent = $op->parent();
49
3
8
                next unless $parent->isa('PPI::Statement')
50                        || $parent->isa('PPI::Structure::Condition')
51                        || $parent->isa('PPI::Structure::Block');
52
3
7
                return 1;
53        }
54
4
9
        return 0;
55}
56
57 - 138
=head2 mutate

Walk a PPI document and generate one mutant for each comparison operator
that can be flipped to reveal a boundary condition not caught by the test
suite. For example, C<E<gt>=> is flipped to C<E<gt>>, C<E<lt>>, and
C<E<lt>=>  in turn, producing three independent mutants.

    my $mutation = App::Test::Generator::Mutation::NumericBoundary->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::NumericBoundary>.

=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
(operator, flip) pair found in the document. Returns an empty list if no
qualifying comparison operators are found.

Each mutant carries a C<transform> closure that when called with a fresh
L<PPI::Document> copy will replace the targeted operator with its flipped
equivalent, targeting the exact operator by line and column number to
ensure that multiple comparison operators on the same source line are each
mutated independently.

=head3 Notes

The following operators and their flips are supported:

    >   flips to  <  >=  <=
    <   flips to  >  <=  >=
    >=  flips to  >  <   <=
    <=  flips to  <  >   >=
    ==  flips to  !=
    !=  flips to  ==

Mutant IDs include line number, column number, and the flip target to
ensure uniqueness even when multiple operators share a source line.

=head3 API specification

=head4 input

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

=head4 output

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

=cut
139
140sub mutate {
141
63
58710
        my ($self, $doc) = @_;
142
143        # Find all operator tokens in the document
144
63
88
        my $ops = $doc->find('PPI::Token::Operator') || [];
145
63
58005
        my @mutants;
146
147
63
63
70
77
        for my $op (@{$ops}) {
148
237
220
                my $original = $op->content();
149
150                # Skip readline operators — < immediately followed by
151                # a symbol token is <$fh> not a numeric comparison
152
237
451
                my $next_sib = $op->next_sibling();
153
237
3204
                next if $next_sib && $next_sib->isa('PPI::Token::Symbol');
154
155                # Only process comparison operators that have defined flips
156
237
265
                next unless exists $FLIP{$original};
157
158                # Only mutate operators that are direct children of
159                # a condition or expression, not list arguments
160
107
127
                my $parent = $op->parent();
161
107
257
                next unless $parent->isa('PPI::Statement')
162                        || $parent->isa('PPI::Structure::Condition')
163                        || $parent->isa('PPI::Structure::Block');
164
165                # Capture location so the transform closure targets the
166                # exact operator rather than the first match on that line
167
107
107
                my $line = $op->location->[0];
168
107
12251
                my $col  = $op->location->[1];
169
170                # Generate one mutant per flip of this operator
171
107
107
459
118
                for my $change (@{ $FLIP{$original} }) {
172                        # Build a unique id from location and the specific flip
173                        # so multiple operators on the same line don't collide
174
299
250
                        my $id = "NUM_BOUNDARY_${line}_${col}_${change}";
175
176
299
198
                        my $mutant = eval {
177                                App::Test::Generator::Mutant->new(
178                                        id          => $id,
179                                        group       => "NUM_BOUNDARY:$line",
180                                        description => "Numeric boundary flip $original to $change",
181                                        original    => $original,
182                                        line        => $line,
183                                        type        => 'comparison',
184
185                                        # The transform closure captures line, col, original
186                                        # and change so it targets precisely the right operator
187                                        # in the document copy it receives at test time
188                                        transform => sub {
189
7
3096
                                                my $doc  = $_[0];
190
7
10
                                                my $ops  = $doc->find('PPI::Token::Operator') || [];
191
192
7
7
3154
28
                                                for my $op (@{$ops}) {
193
7
12
                                                        next unless $op->line_number   == $line;
194
7
2698
                                                        next unless $op->column_number == $col;
195
7
49
                                                        next unless $op->content       eq $original;
196
197                                                        # Safety check — do not mutate if this looks like
198                                                        # a readline operator (<$fh>) rather than a numeric
199                                                        # comparison. A readline < is immediately followed
200                                                        # by a symbol token starting with $
201
7
18
                                                        my $next_sib = $op->next_sibling;
202
7
107
                                                        if($next_sib && $next_sib->isa('PPI::Token::Symbol')) {
203
0
0
                                                                last;
204                                                        }
205
206
7
14
                                                        $op->set_content($change);
207
7
19
                                                        last;
208                                                }
209                                        },
210
299
737
                                );
211                        };
212
213                        # If the Mutant construction fails, report clearly rather than
214                        # silently dropping the mutant from the results
215
299
452
                        if($@ || !$mutant) {
216
0
0
                                warn "Failed to construct mutant $id: $@" if $@;
217
0
0
                                next;
218                        }
219
220
299
282
                        push @mutants, $mutant;
221                }
222        }
223
224
63
157
        return @mutants;
225}
226
2271;