File Coverage

File:blib/lib/App/Test/Generator/Mutation/Base.pm
Coverage:90.7%

linestmtbrancondsubtimecode
1package App::Test::Generator::Mutation::Base;
2
3
18
18
18
198353
16
215
use strict;
4
18
18
18
54
12
306
use warnings;
5
18
18
18
33
9
2923
use Carp qw(croak);
6
7our $VERSION = '0.41';
8
9 - 46
=head1 VERSION

Version 0.41

=head1 DESCRIPTION

Abstract base class for all mutation strategies in
App::Test::Generator. Subclasses must implement both
C<applies_to> and C<mutate>.

=head2 new

Construct a new mutation strategy object.

    my $strategy = My::Mutation::Subclass->new;

=head3 Arguments

None.

=head3 Returns

A blessed hashref of the subclass type.

=head3 API specification

=head4 input

    {}

=head4 output

    {
        type => OBJECT,
        isa  => 'App::Test::Generator::Mutation::Base',
    }

=cut
47
48
522
1228673
sub new { bless {}, shift }
49
50 - 86
=head2 applies_to

Return true if this mutation strategy applies to the
given PPI document. Subclasses must override this method.

    if ($strategy->applies_to($doc)) {
        my @mutants = $strategy->mutate($doc);
    }

=head3 Arguments

=over 4

=item * C<$doc>

A L<PPI::Document> object.

=back

=head3 Returns

A boolean. Croaks if called on the base class directly.

=head3 API specification

=head4 input

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

=head4 output

    { type => SCALAR }

=cut
87
88sub applies_to {
89
4
1726
        my ($self, $doc) = @_;
90
4
22
        croak ref($self) . '::applies_to() must be implemented by subclass';
91}
92
93 - 132
=head2 mutate

Generate and return a list of mutants for the given PPI
document. Subclasses must override this method.

    my @mutants = $strategy->mutate($doc);

=head3 Arguments

=over 4

=item * C<$doc>

A L<PPI::Document> object representing the source file
to mutate. Must not be modified by this method.

=back

=head3 Returns

A list of L<App::Test::Generator::Mutant> objects.
Croaks if called on the base class directly.

=head3 API specification

=head4 input

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

=head4 output

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

=cut
133
134sub mutate {
135
4
1043
        my ($self, $doc) = @_;
136
4
16
        croak ref($self) . '::mutate() must be implemented by subclass';
137}
138
139# --------------------------------------------------
140# _line_content
141#
142# Purpose:    Fetch the raw source text of a single line,
143#             for the optional line_content field on a
144#             Mutant (used by Mutator::_is_redundant_mutation
145#             to skip mutations targeting comment-only lines).
146#
147# Entry:      $doc  - a PPI::Document.
148#             $line - a 1-based line number.
149#
150# Exit:       Returns the text of that line, or '' if out
151#             of range.
152#
153# Side effects: None.
154# --------------------------------------------------
155sub _line_content {
156
864
4122
        my ($self, $doc, $line) = @_;
157
864
901
        my @lines = split /\n/, $doc->serialize;
158
864
1726724
        return $lines[$line - 1] // '';
159}
160
161# --------------------------------------------------
162# _in_conditional
163#
164# Purpose:    Determine whether a PPI node sits inside
165#             (or is itself the keyword of) an if/unless/
166#             while/until compound statement, for the
167#             optional context field on a Mutant.
168#
169# Entry:      $node - a PPI::Element.
170#
171# Exit:       Returns 1 if an ancestor (or the node itself)
172#             is an if/unless/while/until compound statement,
173#             0 otherwise.
174#
175# Side effects: None.
176# --------------------------------------------------
177sub _in_conditional {
178
529
10666
        my ($self, $node) = @_;
179
180
529
717
        for(my $parent = $node; $parent; $parent = $parent->parent) {
181
1979
4778
                next unless $parent->isa('PPI::Statement::Compound');
182
275
289
                my $first = $parent->schild(0);
183
275
1778
                next unless $first && $first->isa('PPI::Token::Word');
184
275
251
                return 1 if $first->content =~ /^(?:if|unless|while|until)$/;
185        }
186
187
254
711
        return 0;
188}
189
1901;