| File: | blib/lib/App/Test/Generator/Mutation/BooleanNegation.pm |
| Coverage: | 91.4% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Mutation::BooleanNegation; | |||||
| 2 | ||||||
| 3 | 19 19 19 | 208688 21 268 | use strict; | |||
| 4 | 19 19 19 | 41 16 422 | use warnings; | |||
| 5 | ||||||
| 6 | 19 19 19 | 197 167 70 | use parent 'App::Test::Generator::Mutation::Base'; | |||
| 7 | 19 19 19 | 2561 24 246 | use App::Test::Generator::Mutant; | |||
| 8 | 19 19 19 | 447 142155 6816 | use PPI; | |||
| 9 | ||||||
| 10 | our $VERSION = '0.46'; | |||||
| 11 | ||||||
| 12 - 61 | =head1 NAME
App::Test::Generator::Mutation::BooleanNegation - Negate boolean return
expressions to expose missing assertion coverage
=head1 VERSION
Version 0.46
=head1 METHODS
=head2 applies_to
Return true if the given document contains at least one return
statement this mutation strategy could mutate. Used by
L<App::Test::Generator::Mutator> to pre-filter strategies before
calling C<mutate>, so a document with nothing to mutate skips the
walk entirely.
my $applies = $mutation->applies_to($doc);
=head3 Arguments
=over 4
=item * C<$doc>
A L<PPI::Document> object to inspect.
=back
=head3 Returns
True if the document contains a C<return> statement (PPI::Statement::Break
whose first token is C<return>), false otherwise.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Mutation::BooleanNegation' },
doc => { type => OBJECT, isa => 'PPI::Document' },
}
=head4 output
{ type => SCALAR }
=cut | |||||
| 62 | ||||||
| 63 | sub applies_to { | |||||
| 64 | 72 | 11086 | my ($self, $doc) = @_; | |||
| 65 | ||||||
| 66 | # PPI >= 1.270 classifies return as PPI::Statement::Break rather | |||||
| 67 | # than PPI::Statement::Return -- scan the whole document for at | |||||
| 68 | # least one qualifying return statement. This must match the | |||||
| 69 | # document-level pre-filter contract used by Mutator::generate_mutants | |||||
| 70 | # (and documented in Mutation::Base) rather than testing a single node, | |||||
| 71 | # otherwise every call from generate_mutants would see $doc itself, | |||||
| 72 | # which is never a PPI::Statement::Break, and mutate() would never run. | |||||
| 73 | my $returns = $doc->find(sub { | |||||
| 74 | 8221 | 31217 | my $node = $_[1]; | |||
| 75 | 8221 | 9630 | return 0 unless $node->isa('PPI::Statement::Break'); | |||
| 76 | 199 | 215 | my $first = $node->schild(0) or return 0; | |||
| 77 | 199 | 1196 | return $first->content eq 'return'; | |||
| 78 | 72 | 317 | }) || []; | |||
| 79 | ||||||
| 80 | 72 72 | 520 192 | return @{$returns} ? 1 : 0; | |||
| 81 | } | |||||
| 82 | ||||||
| 83 - 163 | =head2 mutate
Walk a PPI document and generate one mutant for each return statement
whose expression can be negated. For example, C<return $ok> becomes
C<return !($ok)>.
my $mutation = App::Test::Generator::Mutation::BooleanNegation->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::BooleanNegation>.
=item * C<$doc>
A L<PPI::Document> object representing the parsed source to mutate.
The document is not modified by this method.
=back
=head3 Returns
A list of L<App::Test::Generator::Mutant> objects, one per qualifying
return statement found in the document. Returns an empty list if no
return statements with expressions are found.
Each mutant carries a C<transform> closure that when called with a
fresh L<PPI::Document> copy will wrap the targeted return expression
in C<!( )>, negating its boolean value.
=head3 Notes
Mutant IDs include both line and column number to ensure uniqueness
when multiple return statements appear on different lines of the same
source file.
Only return statements that have an expression child (i.e. not bare
C<return;> statements) are mutated.
Each mutant's optional C<context> field is set to C<conditional> if
the return statement sits inside (or is itself the keyword of) an
C<if>/C<unless>/C<while>/C<until> compound statement, or C<statement>
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::BooleanNegation',
},
doc => {
type => OBJECT,
isa => 'PPI::Document',
},
}
=head4 output
{
type => ARRAYREF,
elements => {
type => OBJECT,
isa => 'App::Test::Generator::Mutant',
},
}
=cut | |||||
| 164 | ||||||
| 165 | sub mutate { | |||||
| 166 | 107 | 55310 | my ($self, $doc) = @_; | |||
| 167 | ||||||
| 168 | # PPI >= 1.270 classifies return statements as PPI::Statement::Break | |||||
| 169 | # (alongside last/next/redo) rather than PPI::Statement::Return. | |||||
| 170 | # Use a custom predicate to match only 'return' Break nodes. | |||||
| 171 | my $returns = $doc->find(sub { | |||||
| 172 | 8957 | 33925 | my $node = $_[1]; | |||
| 173 | # Must be a Break statement -- the parent class for return in | |||||
| 174 | # newer PPI versions | |||||
| 175 | 8957 | 10332 | return 0 unless $node->isa('PPI::Statement::Break'); | |||
| 176 | # Distinguish return from last/next/redo by checking the | |||||
| 177 | # first significant child token | |||||
| 178 | 245 | 243 | my $first = $node->schild(0) or return 0; | |||
| 179 | 245 | 1324 | return $first->content eq 'return'; | |||
| 180 | 107 | 303 | }) || []; | |||
| 181 | ||||||
| 182 | 107 | 682 | my @mutants; | |||
| 183 | ||||||
| 184 | 107 107 | 101 156 | for my $ret (@{$returns}) { | |||
| 185 | # Skip bare return statements with no expression to negate, | |||||
| 186 | # and bare returns with only a postfix conditional/loop | |||||
| 187 | # modifier (return if $cond; has nothing to negate) | |||||
| 188 | 245 | 297 | my @expr = _return_expr_span($ret); | |||
| 189 | 245 | 243 | next unless @expr; | |||
| 190 | ||||||
| 191 | # Skip a lone structure node (e.g. return ($x, $y) gives a | |||||
| 192 | # single PPI::Structure::List child) — wrapping it is not | |||||
| 193 | # useful and there is nothing simple to splice around | |||||
| 194 | 238 | 461 | next if @expr == 1 && !$expr[0]->isa('PPI::Token'); | |||
| 195 | ||||||
| 196 | # Capture location so the transform closure targets the | |||||
| 197 | # exact statement rather than the first match on that line | |||||
| 198 | 238 | 332 | my $line = $ret->location->[0]; | |||
| 199 | 238 | 96699 | my $col = $ret->location->[1]; | |||
| 200 | ||||||
| 201 | # Build a unique ID from line and column so multiple return | |||||
| 202 | # statements in the same file never collide | |||||
| 203 | 238 | 1629 | my $id = "BOOL_NEGATE_${line}_${col}"; | |||
| 204 | ||||||
| 205 | 238 | 190 | my $mutant = eval { | |||
| 206 | App::Test::Generator::Mutant->new( | |||||
| 207 | id => $id, | |||||
| 208 | group => "BOOL_NEGATE:$line", | |||||
| 209 | description => 'Negate boolean return expression', | |||||
| 210 | original => $ret->content, | |||||
| 211 | line => $line, | |||||
| 212 | type => 'boolean', | |||||
| 213 | context => $self->_in_conditional($ret) ? 'conditional' : 'statement', | |||||
| 214 | line_content => $self->_line_content($doc, $line), | |||||
| 215 | ||||||
| 216 | # The transform closure captures line and col so it | |||||
| 217 | # targets precisely the right return statement in the | |||||
| 218 | # document copy it receives at test time | |||||
| 219 | transform => sub { | |||||
| 220 | 15 | 13 | my $doc = $_[0]; | |||
| 221 | ||||||
| 222 | # Locate all return statements in the fresh document copy using | |||||
| 223 | # the same PPI::Statement::Break predicate as the outer find -- | |||||
| 224 | # PPI >= 1.270 no longer uses PPI::Statement::Return | |||||
| 225 | my $rets = $doc->find(sub { | |||||
| 226 | my $node = $_[1]; | |||||
| 227 | # Match Break nodes only -- covers return/last/next/redo | |||||
| 228 | return 0 unless $node->isa('PPI::Statement::Break'); | |||||
| 229 | # Filter to return specifically by inspecting the first token | |||||
| 230 | my $first = $node->schild(0) or return 0; | |||||
| 231 | return $first->content eq 'return'; | |||||
| 232 | 15 | 77 | }) || []; | |||
| 233 | ||||||
| 234 | 15 15 | 92 15 | for my $ret (@{$rets}) { | |||
| 235 | # Match by line and column to avoid mutating | |||||
| 236 | # the wrong return statement | |||||
| 237 | 17 | 1113 | next unless $ret->line_number == $line; | |||
| 238 | 15 | 6295 | next unless $ret->column_number == $col; | |||
| 239 | ||||||
| 240 | # Skip bare returns with no expression | |||||
| 241 | 15 | 144 | my @expr = _return_expr_span($ret); | |||
| 242 | 15 | 22 | last unless @expr; | |||
| 243 | ||||||
| 244 | # Skip a lone structure node | |||||
| 245 | 15 | 42 | last if @expr == 1 && !$expr[0]->isa('PPI::Token'); | |||
| 246 | ||||||
| 247 | # Wrap the whole expression span in !(...) rather | |||||
| 248 | # than just its first token -- $self->{x} is three | |||||
| 249 | # significant children (Symbol, Operator, Structure) | |||||
| 250 | # and wrapping only the leading $self produced the | |||||
| 251 | # broken mutant 'return !($self)->{x};' | |||||
| 252 | 15 | 29 | $expr[0]->insert_before(PPI::Token::Operator->new('!')); | |||
| 253 | 15 | 541 | $expr[0]->insert_before(PPI::Token::Structure->new('(')); | |||
| 254 | 15 | 340 | $expr[-1]->insert_after(PPI::Token::Structure->new(')')); | |||
| 255 | 15 | 416 | last; | |||
| 256 | } | |||||
| 257 | }, | |||||
| 258 | 238 | 338 | ); | |||
| 259 | }; | |||||
| 260 | ||||||
| 261 | # If the Mutant construction fails, report clearly rather than | |||||
| 262 | # silently dropping the mutant from the results | |||||
| 263 | 238 | 500 | if($@ || !$mutant) { | |||
| 264 | 1 | 12 | warn "Failed to construct mutant $id: $@" if $@; | |||
| 265 | 1 | 2 | next; | |||
| 266 | } | |||||
| 267 | ||||||
| 268 | 237 | 284 | push @mutants, $mutant; | |||
| 269 | } | |||||
| 270 | ||||||
| 271 | 107 | 212 | return @mutants; | |||
| 272 | } | |||||
| 273 | ||||||
| 274 | # -------------------------------------------------- | |||||
| 275 | # Purpose: identify the PPI elements making up the expression | |||||
| 276 | # being returned by a 'return' statement, excluding | |||||
| 277 | # the leading 'return' keyword, the trailing statement | |||||
| 278 | # terminator, and any postfix conditional/loop modifier | |||||
| 279 | # (if/unless/while/until/for/foreach) and its condition. | |||||
| 280 | # Entry: a PPI::Statement::Break node already confirmed to be | |||||
| 281 | # a 'return' statement. | |||||
| 282 | # Exit: a list of the significant child elements making up | |||||
| 283 | # the return expression, or an empty list for a bare | |||||
| 284 | # return (with or without a postfix modifier). | |||||
| 285 | # Side effects: none. | |||||
| 286 | # -------------------------------------------------- | |||||
| 287 | sub _return_expr_span { | |||||
| 288 | 262 | 4893 | my ($ret) = @_; | |||
| 289 | ||||||
| 290 | 262 | 325 | my @children = $ret->schildren; | |||
| 291 | 262 | 1632 | shift @children; | |||
| 292 | ||||||
| 293 | 262 | 739 | if(@children && $children[-1]->isa('PPI::Token::Structure') && $children[-1]->content eq ';') { | |||
| 294 | 237 | 496 | pop @children; | |||
| 295 | } | |||||
| 296 | ||||||
| 297 | 262 | 364 | for my $i (0 .. $#children) { | |||
| 298 | 463 | 370 | my $child = $children[$i]; | |||
| 299 | 463 | 704 | next unless $child->isa('PPI::Token::Word'); | |||
| 300 | 22 | 34 | next unless $child->content =~ /^(?:if|unless|while|until|for|foreach)$/; | |||
| 301 | 11 | 39 | @children = @children[0 .. $i - 1]; | |||
| 302 | 11 | 11 | last; | |||
| 303 | } | |||||
| 304 | ||||||
| 305 | 262 | 301 | return @children; | |||
| 306 | } | |||||
| 307 | ||||||
| 308 - 330 | =head1 AUTHOR Nigel Horne, C<< <njh at nigelhorne.com> >> =head1 LICENCE AND COPYRIGHT Copyright 2026 Nigel Horne. Usage is subject to licence terms. The licence terms of this software are as follows: =over 4 =item * Personal single user, single computer use: GPL2 =item * All other users (including Commercial, Charity, Educational, Government) must apply in writing for a licence for use from Nigel Horne at the above e-mail. =back =cut | |||||
| 331 | ||||||
| 332 | 1; | |||||