File Coverage

File:blib/lib/App/Test/Generator/Mutation/BooleanNegation.pm
Coverage:91.4%

linestmtbrancondsubtimecode
1package App::Test::Generator::Mutation::BooleanNegation;
2
3
14
14
14
199914
15
180
use strict;
4
14
14
14
22
12
278
use warnings;
5
6
14
14
14
160
121
58
use parent 'App::Test::Generator::Mutation::Base';
7
14
14
14
1817
16
191
use App::Test::Generator::Mutant;
8
14
14
14
439
137427
4954
use PPI;
9
10our $VERSION = '0.41';
11
12 - 61
=head1 NAME

App::Test::Generator::Mutation::BooleanNegation - Negate boolean return
expressions to expose missing assertion coverage

=head1 VERSION

Version 0.41

=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
63sub applies_to {
64
55
10394
        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
5578
21115
                my $node = $_[1];
75
5578
6378
                return 0 unless $node->isa('PPI::Statement::Break');
76
159
196
                my $first = $node->schild(0) or return 0;
77
159
851
                return $first->content eq 'return';
78
55
184
        }) || [];
79
80
55
55
373
144
        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
165sub mutate {
166
90
54312
        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
6314
23790
                my $node = $_[1];
173                # Must be a Break statement -- the parent class for return in
174                # newer PPI versions
175
6314
7238
                return 0 unless $node->isa('PPI::Statement::Break');
176                # Distinguish return from last/next/redo by checking the
177                # first significant child token
178
205
177
                my $first = $node->schild(0) or return 0;
179
205
1106
                return $first->content eq 'return';
180
90
276
        }) || [];
181
182
90
521
        my @mutants;
183
184
90
90
78
107
        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
205
216
                my @expr = _return_expr_span($ret);
189
205
194
                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
198
354
                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
198
272
                my $line = $ret->location->[0];
199
198
66672
                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
198
1303
                my $id = "BOOL_NEGATE_${line}_${col}";
204
205
198
156
                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
14
14
                                        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
14
39
                                        }) || [];
233
234
14
14
82
14
                                        for my $ret (@{$rets}) {
235                                                # Match by line and column to avoid mutating
236                                                # the wrong return statement
237
16
1101
                                                next unless $ret->line_number   == $line;
238
14
5744
                                                next unless $ret->column_number == $col;
239
240                                                # Skip bare returns with no expression
241
14
122
                                                my @expr = _return_expr_span($ret);
242
14
16
                                                last unless @expr;
243
244                                                # Skip a lone structure node
245
14
28
                                                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
14
24
                                                $expr[0]->insert_before(PPI::Token::Operator->new('!'));
253
14
427
                                                $expr[0]->insert_before(PPI::Token::Structure->new('('));
254
14
287
                                                $expr[-1]->insert_after(PPI::Token::Structure->new(')'));
255
14
360
                                                last;
256                                        }
257                                },
258
198
262
                        );
259                };
260
261                # If the Mutant construction fails, report clearly rather than
262                # silently dropping the mutant from the results
263
198
989
                if($@ || !$mutant) {
264
1
5
                        warn "Failed to construct mutant $id: $@" if $@;
265
1
508
                        next;
266                }
267
268
197
224
                push @mutants, $mutant;
269        }
270
271
90
168
        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# --------------------------------------------------
287sub _return_expr_span {
288
221
4848
        my ($ret) = @_;
289
290
221
267
        my @children = $ret->schildren;
291
221
1258
        shift @children;
292
293
221
622
        if(@children && $children[-1]->isa('PPI::Token::Structure') && $children[-1]->content eq ';') {
294
215
478
                pop @children;
295        }
296
297
221
262
        for my $i (0 .. $#children) {
298
360
396
                my $child = $children[$i];
299
360
534
                next unless $child->isa('PPI::Token::Word');
300
20
20
                next unless $child->content =~ /^(?:if|unless|while|until|for|foreach)$/;
301
11
38
                @children = @children[0 .. $i - 1];
302
11
7
                last;
303        }
304
305
221
224
        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
3321;