File Coverage

File:blib/lib/App/Test/Generator/Analyzer/SideEffect.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1package App::Test::Generator::Analyzer::SideEffect;
2
3
38
38
38
148948
27
473
use strict;
4
38
38
38
60
27
582
use warnings;
5
38
38
38
53
29
2263
use Readonly;
6
7# --------------------------------------------------
8# Purity classification labels
9# --------------------------------------------------
10Readonly my $PURITY_PURE         => 'pure';
11Readonly my $PURITY_SELF_MUTATING => 'self_mutating';
12Readonly my $PURITY_IMPURE       => 'impure';
13
14# --------------------------------------------------
15# IO operation keywords — print/say/warn/open etc.
16# NOTE: this list is not exhaustive; low-level sysread
17# and syswrite are included but higher-level abstractions
18# like Log::Any calls are not detected.
19# --------------------------------------------------
20
38
38
38
94
30
1613
use constant IO_PATTERN => qr/\b(?:print|say|printf|warn|open|close|syswrite|sysread|readline|read|write)\b/;
21
22# --------------------------------------------------
23# External execution patterns — system calls and
24# backtick/qx operators
25# --------------------------------------------------
26
38
38
38
76
28
1691
use constant EXEC_PATTERN => qr/\b(?:system|exec)\b|qx\(|`/;
27
28# --------------------------------------------------
29# Global variable patterns — %ENV, %SIG, @ARGV and
30# common Perl special variables.
31# NOTE: does not detect all possible globals; mutation
32# of $_, $/, $! etc. would require deeper analysis.
33# --------------------------------------------------
34
38
38
38
68
30
8771
use constant GLOBAL_PATTERN => qr/\$(?:GLOBAL|ENV|SIG|ARGV|_|!|0)\b|\$\/|%ENV\b|%SIG\b|\@ARGV\b/;
35
36our $VERSION = '0.46';
37
38 - 77
=head1 VERSION

Version 0.46

=head1 DESCRIPTION

Analyses the source body of a method and produces a side effect report
describing whether the method mutates C<$self>, mutates global state,
performs IO, or calls external commands. Used by
L<App::Test::Generator> to classify methods by purity and guide test
generation strategy.

=head2 new

Construct a new SideEffect analyser.

    my $analyser = App::Test::Generator::Analyzer::SideEffect->new;

=head3 Arguments

None.

=head3 Returns

A blessed hashref.

=head3 API specification

=head4 input

    {}

=head4 output

    {
        type => OBJECT,
        isa  => 'App::Test::Generator::Analyzer::SideEffect',
    }

=cut
78
79
405
171366
sub new { bless {}, shift }
80
81 - 156
=head2 analyze

Analyse the source body of a method and return a side effect report
hashref.

    my $analyser = App::Test::Generator::Analyzer::SideEffect->new;
    my $report   = $analyser->analyze($method);

    if ($report->{purity_level} eq 'pure') {
        print "Method is side-effect free\n";
    }

=head3 Arguments

=over 4

=item * C<$method>

A hashref with a C<body> key containing the raw source text of the
method to analyse.

=back

=head3 Returns

A hashref with the following keys:

=over 4

=item * C<mutates_self> — 1 if the method assigns to C<$self-E<gt>{field}>.

=item * C<mutates_globals> — 1 if the method modifies global variables.

=item * C<performs_io> — 1 if the method performs IO operations.

=item * C<calls_external> — 1 if the method calls external commands.

=item * C<mutation_fields> — arrayref of C<$self> field names assigned
to (deduplicated).

=item * C<purity_level> — one of C<pure>, C<self_mutating>, or
C<impure>.

=back

=head3 Notes

Detection is based on regex pattern matching against the raw source
text and will not catch dynamically constructed calls or aliased
operations. The global variable pattern covers common Perl specials
but is not exhaustive.

=head3 API specification

=head4 input

    {
        self   => { type => OBJECT, isa => 'App::Test::Generator::Analyzer::SideEffect' },
        method => { type => HASHREF },
    }

=head4 output

    {
        type => HASHREF,
        keys => {
            mutates_self    => { type => SCALAR },
            mutates_globals => { type => SCALAR },
            performs_io     => { type => SCALAR },
            calls_external  => { type => SCALAR },
            mutation_fields => { type => ARRAYREF },
            purity_level    => { type => SCALAR },
        },
    }

=cut
157
158sub analyze {
159
419
7746
        my ($self, $method) = @_;
160
161        # Method argument is a raw hashref from SchemaExtractor
162
419
511
        my $body = $method->{body} // '';
163
164        # IO/exec keywords are only real side effects as bare identifiers;
165        # the same words inside string literals or comments (e.g. a log
166        # message "system check failed" or a comment "# warn the caller")
167        # must not trigger a false positive
168
418
480
        my $code_only = _strip_strings_and_comments($body);
169
170
418
931
        my %result = (
171                mutates_self    => 0,
172                mutates_globals => 0,
173                performs_io     => 0,
174                calls_external  => 0,
175                mutation_fields => [],
176        );
177
178        # --------------------------------------------------
179        # Detect assignment to $self->{field} — any such
180        # assignment means the method mutates its own state.
181        # Matched against $code_only so a field-assignment-like
182        # fragment appearing inside a string literal or comment
183        # is not mistaken for an actual mutation.
184        # --------------------------------------------------
185
418
323
        my %seen_fields;
186
418
704
        while($code_only =~ /\$self->\{(\w+)\}\s*=/g) {
187
61
62
                $result{mutates_self} = 1;
188
189                # Deduplicate field names in case the same field
190                # is assigned more than once in the method body
191
56
147
                push @{ $result{mutation_fields} }, $1
192
61
128
                        unless $seen_fields{$1}++;
193        }
194
195        # --------------------------------------------------
196        # Detect mutation of global variables — %ENV, %SIG,
197        # @ARGV and common Perl special variables. Matched
198        # against $code_only for the same reason as above.
199        # NOTE: does not catch all possible globals.
200        # --------------------------------------------------
201
418
1124
        if($code_only =~ GLOBAL_PATTERN) {
202
37
39
                $result{mutates_globals} = 1;
203        }
204
205        # --------------------------------------------------
206        # Detect IO operations — print, say, warn, open etc.
207        # Higher-level logging abstractions are not detected.
208        # Matched against $code_only so a keyword appearing
209        # inside a string literal or comment is not mistaken
210        # for an actual IO call.
211        # --------------------------------------------------
212
418
1244
        if($code_only =~ IO_PATTERN) {
213
25
33
                $result{performs_io} = 1;
214        }
215
216        # --------------------------------------------------
217        # Detect external command execution via system(),
218        # exec(), qx() or backtick operators. Matched against
219        # $code_only for the same reason as IO_PATTERN above.
220        # --------------------------------------------------
221
418
2651
        if($code_only =~ EXEC_PATTERN) {
222
10
12
                $result{calls_external} = 1;
223        }
224
225        # --------------------------------------------------
226        # Classify purity level based on detected side effects.
227        # pure         â€” no side effects of any kind
228        # self_mutating — only mutates own state, no external effects
229        # impure       â€” any external side effect present
230        # --------------------------------------------------
231        my $has_external = $result{mutates_globals}
232                || $result{performs_io}
233
418
984
                || $result{calls_external};
234
235        $result{purity_level} =
236                !$result{mutates_self} && !$has_external ? $PURITY_PURE         :
237
418
1209
                $result{mutates_self}  && !$has_external ? $PURITY_SELF_MUTATING :
238                                                           $PURITY_IMPURE;
239
240
418
1253
        return \%result;
241}
242
243# --------------------------------------------------
244# Purpose: blank out the contents of '...' and "..." string
245#          literals and # line comments so that keyword regexes
246#          (IO_PATTERN, EXEC_PATTERN) only match real code, not
247#          words that merely appear inside a message or comment.
248# Entry:   a raw source body string.
249# Exit:    the same string with string-literal contents and
250#          comment text replaced by blanks, same overall layout.
251# Side effects: none. Best-effort only — does not handle q//,
252#          qq//, heredocs, or quote-like operators with custom
253#          delimiters.
254# --------------------------------------------------
255sub _strip_strings_and_comments {
256
421
1874
        my ($body) = @_;
257
258
421
926
        $body =~ s/"(?:[^"\\]|\\.)*"//g;
259
421
683
        $body =~ s/'(?:[^'\\]|\\.)*'//g;
260
421
406
        $body =~ s/#.*$//mg;
261
262
421
410
        return $body;
263}
264
2651;