| File: | blib/lib/App/Test/Generator/Analyzer/SideEffect.pm |
| Coverage: | 100.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Analyzer::SideEffect; | |||||
| 2 | ||||||
| 3 | 24 24 24 | 65252 18 292 | use strict; | |||
| 4 | 24 24 24 | 35 18 367 | use warnings; | |||
| 5 | 24 24 24 | 33 18 1558 | use Readonly; | |||
| 6 | ||||||
| 7 | # -------------------------------------------------- | |||||
| 8 | # Purity classification labels | |||||
| 9 | # -------------------------------------------------- | |||||
| 10 | Readonly my $PURITY_PURE => 'pure'; | |||||
| 11 | Readonly my $PURITY_SELF_MUTATING => 'self_mutating'; | |||||
| 12 | Readonly 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 | 24 24 24 | 53 18 951 | 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 | 24 24 24 | 45 19 1062 | 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 | 24 24 24 | 42 16 4374 | use constant GLOBAL_PATTERN => qr/\$(?:GLOBAL|ENV|SIG|ARGV|_|!|0)\b|\$\/|%ENV\b|%SIG\b|\@ARGV\b/; | |||
| 35 | ||||||
| 36 | our $VERSION = '0.36'; | |||||
| 37 | ||||||
| 38 - 77 | =head1 VERSION
Version 0.36
=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 | 311 | 110804 | 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 | ||||||
| 158 | sub analyze { | |||||
| 159 | 312 | 936 | my ($self, $method) = @_; | |||
| 160 | ||||||
| 161 | # Method argument is a raw hashref from SchemaExtractor | |||||
| 162 | 312 | 374 | my $body = $method->{body} // ''; | |||
| 163 | ||||||
| 164 | 312 | 625 | my %result = ( | |||
| 165 | mutates_self => 0, | |||||
| 166 | mutates_globals => 0, | |||||
| 167 | performs_io => 0, | |||||
| 168 | calls_external => 0, | |||||
| 169 | mutation_fields => [], | |||||
| 170 | ); | |||||
| 171 | ||||||
| 172 | # -------------------------------------------------- | |||||
| 173 | # Detect assignment to $self->{field} — any such | |||||
| 174 | # assignment means the method mutates its own state | |||||
| 175 | # -------------------------------------------------- | |||||
| 176 | 312 | 214 | my %seen_fields; | |||
| 177 | 312 | 479 | while($body =~ /\$self->\{(\w+)\}\s*=/g) { | |||
| 178 | 35 | 30 | $result{mutates_self} = 1; | |||
| 179 | ||||||
| 180 | # Deduplicate field names in case the same field | |||||
| 181 | # is assigned more than once in the method body | |||||
| 182 | 33 | 66 | push @{ $result{mutation_fields} }, $1 | |||
| 183 | 35 | 59 | unless $seen_fields{$1}++; | |||
| 184 | } | |||||
| 185 | ||||||
| 186 | # -------------------------------------------------- | |||||
| 187 | # Detect mutation of global variables — %ENV, %SIG, | |||||
| 188 | # @ARGV and common Perl special variables. | |||||
| 189 | # NOTE: does not catch all possible globals. | |||||
| 190 | # -------------------------------------------------- | |||||
| 191 | 312 | 801 | if($body =~ GLOBAL_PATTERN) { | |||
| 192 | 18 | 16 | $result{mutates_globals} = 1; | |||
| 193 | } | |||||
| 194 | ||||||
| 195 | # -------------------------------------------------- | |||||
| 196 | # Detect IO operations — print, say, warn, open etc. | |||||
| 197 | # Higher-level logging abstractions are not detected. | |||||
| 198 | # -------------------------------------------------- | |||||
| 199 | 312 | 872 | if($body =~ IO_PATTERN) { | |||
| 200 | 17 | 14 | $result{performs_io} = 1; | |||
| 201 | } | |||||
| 202 | ||||||
| 203 | # -------------------------------------------------- | |||||
| 204 | # Detect external command execution via system(), | |||||
| 205 | # exec(), qx() or backtick operators | |||||
| 206 | # -------------------------------------------------- | |||||
| 207 | 312 | 1786 | if($body =~ EXEC_PATTERN) { | |||
| 208 | 7 | 6 | $result{calls_external} = 1; | |||
| 209 | } | |||||
| 210 | ||||||
| 211 | # -------------------------------------------------- | |||||
| 212 | # Classify purity level based on detected side effects. | |||||
| 213 | # pure — no side effects of any kind | |||||
| 214 | # self_mutating — only mutates own state, no external effects | |||||
| 215 | # impure — any external side effect present | |||||
| 216 | # -------------------------------------------------- | |||||
| 217 | my $has_external = $result{mutates_globals} | |||||
| 218 | || $result{performs_io} | |||||
| 219 | 312 | 665 | || $result{calls_external}; | |||
| 220 | ||||||
| 221 | $result{purity_level} = | |||||
| 222 | !$result{mutates_self} && !$has_external ? $PURITY_PURE : | |||||
| 223 | 312 | 813 | $result{mutates_self} && !$has_external ? $PURITY_SELF_MUTATING : | |||
| 224 | $PURITY_IMPURE; | |||||
| 225 | ||||||
| 226 | 312 | 949 | return \%result; | |||
| 227 | } | |||||
| 228 | ||||||
| 229 | 1; | |||||