lib/App/Test/Generator/Mutation/BooleanNegation.pm — Duplicate Code Regions
◆ Amber lines duplicate code in another file — hover for location. ◆ Purple: duplicate of another region within this same file.
1: package App::Test::Generator::Mutation::BooleanNegation;
2:
3: use strict;
4: use warnings;
5:
6: use parent 'App::Test::Generator::Mutation::Base';
7: use App::Test::Generator::Mutant;
8: use PPI;
9:
10: our $VERSION = '0.46';
11:
12: =head1 NAME
13:
14: App::Test::Generator::Mutation::BooleanNegation - Negate boolean return
15: expressions to expose missing assertion coverage
16:
17: =head1 VERSION
18:
19: Version 0.46
20:
21: =head1 METHODS
22:
23: =head2 applies_to
24:
25: Return true if the given document contains at least one return
26: statement this mutation strategy could mutate. Used by
27: L<App::Test::Generator::Mutator> to pre-filter strategies before
28: calling C<mutate>, so a document with nothing to mutate skips the
29: walk entirely.
30:
31: my $applies = $mutation->applies_to($doc);
32:
33: =head3 Arguments
34:
35: =over 4
36:
37: =item * C<$doc>
38:
39: A L<PPI::Document> object to inspect.
40:
41: =back
42:
43: =head3 Returns
44:
45: True if the document contains a C<return> statement (PPI::Statement::Break
46: whose first token is C<return>), false otherwise.
47:
48: =head3 API specification
49:
50: =head4 input
51:
52: {
53: self => { type => OBJECT, isa => 'App::Test::Generator::Mutation::BooleanNegation' },
54: doc => { type => OBJECT, isa => 'PPI::Document' },
55: }
56:
57: =head4 output
58:
59: { type => SCALAR }
60:
61: =cut
62:
63: sub applies_to {
64: 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: my $node = $_[1];
75: return 0 unless $node->isa('PPI::Statement::Break');
76: my $first = $node->schild(0) or return 0;
77: return $first->content eq 'return';
78: }) || [];
79:
80: return @{$returns} ? 1 : 0;
81: }
82:
83: =head2 mutate
84:
85: Walk a PPI document and generate one mutant for each return statement
86: whose expression can be negated. For example, C<return $ok> becomes
87: C<return !($ok)>.
88:
89: my $mutation = App::Test::Generator::Mutation::BooleanNegation->new;
90: my $doc = PPI::Document->new(\$source);
91: my @mutants = $mutation->mutate($doc);
92:
93: for my $m (@mutants) {
94: print $m->id, ': ', $m->description, "\n";
95: }
96:
97: =head3 Arguments
98:
99: =over 4
100:
101: =item * C<$self>
102:
103: An instance of C<App::Test::Generator::Mutation::BooleanNegation>.
104:
105: =item * C<$doc>
106:
107: A L<PPI::Document> object representing the parsed source to mutate.
108: The document is not modified by this method.
109:
110: =back
111:
112: =head3 Returns
113:
114: A list of L<App::Test::Generator::Mutant> objects, one per qualifying
115: return statement found in the document. Returns an empty list if no
116: return statements with expressions are found.
117:
118: Each mutant carries a C<transform> closure that when called with a
119: fresh L<PPI::Document> copy will wrap the targeted return expression
120: in C<!( )>, negating its boolean value.
121:
122: =head3 Notes
123:
124: Mutant IDs include both line and column number to ensure uniqueness
125: when multiple return statements appear on different lines of the same
126: source file.
127:
128: Only return statements that have an expression child (i.e. not bare
129: C<return;> statements) are mutated.
130:
131: Each mutant's optional C<context> field is set to C<conditional> if
132: the return statement sits inside (or is itself the keyword of) an
133: C<if>/C<unless>/C<while>/C<until> compound statement, or C<statement>
134: otherwise; its C<line_content> field holds the raw source text of the
135: mutated line. Both are consumed by
136: L<App::Test::Generator::Mutator>'s fast-mode dedup.
137:
138: =head3 API specification
139:
140: =head4 input
141:
142: {
143: self => {
144: type => OBJECT,
145: isa => 'App::Test::Generator::Mutation::BooleanNegation',
146: },
147: doc => {
148: type => OBJECT,
149: isa => 'PPI::Document',
150: },
151: }
152:
153: =head4 output
154:
155: {
156: type => ARRAYREF,
157: elements => {
158: type => OBJECT,
159: isa => 'App::Test::Generator::Mutant',
160: },
161: }
162:
163: =cut
164:
165: sub mutate {
166: 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: my $node = $_[1];
173: # Must be a Break statement -- the parent class for return in
174: # newer PPI versions
175: return 0 unless $node->isa('PPI::Statement::Break');
176: # Distinguish return from last/next/redo by checking the
177: # first significant child token
178: my $first = $node->schild(0) or return 0;
179: return $first->content eq 'return';
180: }) || [];
181:
182: my @mutants;
183:
184: 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: ◆ my @expr = _return_expr_span($ret); 189: ◆ 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: ◆ 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: my $line = $ret->location->[0];
199: 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: my $id = "BOOL_NEGATE_${line}_${col}";
204:
205: 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: ◆ 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: }) || [];
233:
234: for my $ret (@{$rets}) {
235: # Match by line and column to avoid mutating
236: # the wrong return statement
237: next unless $ret->line_number == $line;
238: next unless $ret->column_number == $col;
239:
240: # Skip bare returns with no expression
241: my @expr = _return_expr_span($ret);
242: last unless @expr;
243:
244: # Skip a lone structure node
245: 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: $expr[0]->insert_before(PPI::Token::Operator->new('!'));
253: $expr[0]->insert_before(PPI::Token::Structure->new('('));
254: $expr[-1]->insert_after(PPI::Token::Structure->new(')'));
255: last;
256: }
257: },
258: );
259: };
260:
261: # If the Mutant construction fails, report clearly rather than
262: # silently dropping the mutant from the results
263: if($@ || !$mutant) {
264: warn "Failed to construct mutant $id: $@" if $@;
265: next;
266: }
267:
268: push @mutants, $mutant;
269: }
270:
271: 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: my ($ret) = @_;
289:
290: my @children = $ret->schildren;
291: shift @children;
292:
293: if(@children && $children[-1]->isa('PPI::Token::Structure') && $children[-1]->content eq ';') {
294: pop @children;
295: }
296:
297: for my $i (0 .. $#children) {
298: my $child = $children[$i];
299: next unless $child->isa('PPI::Token::Word');
300: next unless $child->content =~ /^(?:if|unless|while|until|for|foreach)$/;
301: @children = @children[0 .. $i - 1];
302: last;
303: }
304:
305: return @children;
306: }
307:
308: =head1 AUTHOR
309:
310: Nigel Horne, C<< <njh at nigelhorne.com> >>
311:
312: =head1 LICENCE AND COPYRIGHT
313:
314: Copyright 2026 Nigel Horne.
315:
316: Usage is subject to licence terms.
317:
318: The licence terms of this software are as follows:
319:
320: =over 4
321:
322: =item * Personal single user, single computer use: GPL2
323:
324: =item * All other users (including Commercial, Charity, Educational,
325: Government) must apply in writing for a licence for use from Nigel Horne
326: at the above e-mail.
327:
328: =back
329:
330: =cut
331:
332: 1;