| File: | blib/lib/App/Test/Generator/Mutation/NumericBoundary.pm |
| Coverage: | 87.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Mutation::NumericBoundary; | |||||
| 2 | ||||||
| 3 | 14 14 14 | 267058 12 174 | use strict; | |||
| 4 | 14 14 14 | 20 13 244 | use warnings; | |||
| 5 | 14 14 14 | 23 8 273 | use Carp qw(croak); | |||
| 6 | 14 14 14 | 23 13 33 | use parent 'App::Test::Generator::Mutation::Base'; | |||
| 7 | 14 14 14 | 662 15 114 | use App::Test::Generator::Mutant; | |||
| 8 | 14 14 14 | 18 11 3441 | use PPI; | |||
| 9 | ||||||
| 10 | our $VERSION = '0.41'; | |||||
| 11 | ||||||
| 12 - 16 | =head1 VERSION Version 0.41 =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 | # -------------------------------------------------- | |||||
| 24 | my %FLIP = ( | |||||
| 25 | '>' => [ '<', '>=', '<=' ], | |||||
| 26 | '<' => [ '>', '<=', '>=' ], | |||||
| 27 | '>=' => [ '>', '<', '<=' ], | |||||
| 28 | '<=' => [ '<', '>', '>=' ], | |||||
| 29 | '==' => [ '!=' ], | |||||
| 30 | '!=' => [ '==' ], | |||||
| 31 | ); | |||||
| 32 | ||||||
| 33 - 66 | =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<!=>).
=head3 Arguments
=over 4
=item * C<$doc>
A L<PPI::Document> object to inspect.
=back
=head3 Returns
A boolean.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutation::NumericBoundary' },
doc => { type => OBJECT, isa => 'PPI::Document' },
}
=head4 output
{ type => SCALAR }
=cut | |||||
| 67 | ||||||
| 68 | sub applies_to { | |||||
| 69 | 53 | 6839 | my ($self, $doc) = @_; | |||
| 70 | 53 | 68 | my $ops = $doc->find('PPI::Token::Operator') || []; | |||
| 71 | 53 53 | 59928 88 | for my $op (@{$ops}) { | |||
| 72 | 155 | 281 | next unless exists $FLIP{$op->content()}; | |||
| 73 | 36 | 107 | my $parent = $op->parent(); | |||
| 74 | 36 | 123 | next unless $parent->isa('PPI::Statement') | |||
| 75 | || $parent->isa('PPI::Structure::Condition') | |||||
| 76 | || $parent->isa('PPI::Structure::Block'); | |||||
| 77 | 36 | 72 | return 1; | |||
| 78 | } | |||||
| 79 | 17 | 43 | return 0; | |||
| 80 | } | |||||
| 81 | ||||||
| 82 - 170 | =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.
Each mutant's optional C<context> field is set to C<conditional> if
the operator sits inside (or is itself the keyword of) an
C<if>/C<unless>/C<while>/C<until> compound statement, or C<expression>
otherwise; its C<line_content> field holds the raw source text of the
mutated line. Both are consumed by
L<App::Test::Generator::Mutator>'s fast-mode dedup.
=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 | |||||
| 171 | ||||||
| 172 | sub mutate { | |||||
| 173 | 74 | 68125 | my ($self, $doc) = @_; | |||
| 174 | ||||||
| 175 | # Find all operator tokens in the document | |||||
| 176 | 74 | 121 | my $ops = $doc->find('PPI::Token::Operator') || []; | |||
| 177 | 74 | 69004 | my @mutants; | |||
| 178 | ||||||
| 179 | 74 74 | 74 90 | for my $op (@{$ops}) { | |||
| 180 | 312 | 286 | my $original = $op->content(); | |||
| 181 | ||||||
| 182 | # Only process comparison operators that have defined flips | |||||
| 183 | 312 | 561 | next unless exists $FLIP{$original}; | |||
| 184 | ||||||
| 185 | # Only mutate operators that are direct children of | |||||
| 186 | # a condition or expression, not list arguments | |||||
| 187 | 133 | 152 | my $parent = $op->parent(); | |||
| 188 | 133 | 412 | next unless $parent->isa('PPI::Statement') | |||
| 189 | || $parent->isa('PPI::Structure::Condition') | |||||
| 190 | || $parent->isa('PPI::Structure::Block'); | |||||
| 191 | ||||||
| 192 | # Capture location so the transform closure targets the | |||||
| 193 | # exact operator rather than the first match on that line | |||||
| 194 | 133 | 152 | my $line = $op->location->[0]; | |||
| 195 | 133 | 15238 | my $col = $op->location->[1]; | |||
| 196 | ||||||
| 197 | # PPI always wraps a condition's content in a | |||||
| 198 | # PPI::Statement::Expression, so the operator's immediate | |||||
| 199 | # parent is never literally PPI::Structure::Condition -- | |||||
| 200 | # use the shared ancestor-walking helper instead, as | |||||
| 201 | # BooleanNegation and ReturnUndef do, to correctly detect | |||||
| 202 | # operators inside if/unless/while/until conditions | |||||
| 203 | 133 | 673 | my $context = $self->_in_conditional($op) ? 'conditional' : 'expression'; | |||
| 204 | ||||||
| 205 | # Generate one mutant per flip of this operator | |||||
| 206 | 133 133 | 399 142 | for my $change (@{ $FLIP{$original} }) { | |||
| 207 | # Build a unique id from location and the specific flip | |||||
| 208 | # so multiple operators on the same line don't collide | |||||
| 209 | 371 | 372 | my $id = "NUM_BOUNDARY_${line}_${col}_${change}"; | |||
| 210 | ||||||
| 211 | 371 | 246 | my $mutant = eval { | |||
| 212 | App::Test::Generator::Mutant->new( | |||||
| 213 | id => $id, | |||||
| 214 | group => "NUM_BOUNDARY:$line", | |||||
| 215 | description => "Numeric boundary flip $original to $change", | |||||
| 216 | original => $original, | |||||
| 217 | line => $line, | |||||
| 218 | type => 'comparison', | |||||
| 219 | context => $context, | |||||
| 220 | line_content => $self->_line_content($doc, $line), | |||||
| 221 | ||||||
| 222 | # The transform closure captures line, col, original | |||||
| 223 | # and change so it targets precisely the right operator | |||||
| 224 | # in the document copy it receives at test time | |||||
| 225 | transform => sub { | |||||
| 226 | 9 | 3130 | my $doc = $_[0]; | |||
| 227 | 9 | 11 | my $ops = $doc->find('PPI::Token::Operator') || []; | |||
| 228 | ||||||
| 229 | 9 9 | 4009 10 | for my $op (@{$ops}) { | |||
| 230 | 12 | 486 | next unless $op->line_number == $line; | |||
| 231 | 11 | 3151 | next unless $op->column_number == $col; | |||
| 232 | 9 | 61 | next unless $op->content eq $original; | |||
| 233 | ||||||
| 234 | 9 | 25 | $op->set_content($change); | |||
| 235 | 9 | 19 | last; | |||
| 236 | } | |||||
| 237 | }, | |||||
| 238 | 371 | 580 | ); | |||
| 239 | }; | |||||
| 240 | ||||||
| 241 | # If the Mutant construction fails, report clearly rather than | |||||
| 242 | # silently dropping the mutant from the results | |||||
| 243 | 371 | 3049 | if($@ || !$mutant) { | |||
| 244 | 6 | 16 | warn "Failed to construct mutant $id: $@" if $@; | |||
| 245 | 6 | 2041 | next; | |||
| 246 | } | |||||
| 247 | ||||||
| 248 | 365 | 394 | push @mutants, $mutant; | |||
| 249 | } | |||||
| 250 | } | |||||
| 251 | ||||||
| 252 | 74 | 162 | return @mutants; | |||
| 253 | } | |||||
| 254 | ||||||
| 255 | 1; | |||||