| 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 | 31 31 31 | 67446 24 385 | use strict; | |||
| 4 | 31 31 31 | 45 42 479 | use warnings; | |||
| 5 | 31 31 31 | 46 23 1853 | 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 | 31 31 31 | 67 23 1238 | 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 | 31 31 31 | 59 25 1358 | 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 | 31 31 31 | 57 21 7157 | use constant GLOBAL_PATTERN => qr/\$(?:GLOBAL|ENV|SIG|ARGV|_|!|0)\b|\$\/|%ENV\b|%SIG\b|\@ARGV\b/; | |||
| 35 | ||||||
| 36 | our $VERSION = '0.41'; | |||||
| 37 | ||||||
| 38 - 77 | =head1 VERSION
Version 0.41
=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 | 339 | 119157 | 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 | 340 | 1200 | my ($self, $method) = @_; | |||
| 160 | ||||||
| 161 | # Method argument is a raw hashref from SchemaExtractor | |||||
| 162 | 340 | 372 | 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 | 339 | 350 | my $code_only = _strip_strings_and_comments($body); | |||
| 169 | ||||||
| 170 | 339 | 617 | 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 | 339 | 230 | my %seen_fields; | |||
| 186 | 339 | 459 | while($code_only =~ /\$self->\{(\w+)\}\s*=/g) { | |||
| 187 | 38 | 36 | $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 | 36 | 74 | push @{ $result{mutation_fields} }, $1 | |||
| 192 | 38 | 67 | 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 | 339 | 765 | if($code_only =~ GLOBAL_PATTERN) { | |||
| 202 | 23 | 22 | $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 | 339 | 850 | if($code_only =~ IO_PATTERN) { | |||
| 213 | 19 | 19 | $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 | 339 | 1834 | if($code_only =~ EXEC_PATTERN) { | |||
| 222 | 8 | 7 | $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 | 339 | 669 | || $result{calls_external}; | |||
| 234 | ||||||
| 235 | $result{purity_level} = | |||||
| 236 | !$result{mutates_self} && !$has_external ? $PURITY_PURE : | |||||
| 237 | 339 | 810 | $result{mutates_self} && !$has_external ? $PURITY_SELF_MUTATING : | |||
| 238 | $PURITY_IMPURE; | |||||
| 239 | ||||||
| 240 | 339 | 977 | 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 | # -------------------------------------------------- | |||||
| 255 | sub _strip_strings_and_comments { | |||||
| 256 | 342 | 1725 | my ($body) = @_; | |||
| 257 | ||||||
| 258 | 342 | 550 | $body =~ s/"(?:[^"\\]|\\.)*"//g; | |||
| 259 | 342 | 358 | $body =~ s/'(?:[^'\\]|\\.)*'//g; | |||
| 260 | 342 | 281 | $body =~ s/#.*$//mg; | |||
| 261 | ||||||
| 262 | 342 | 303 | return $body; | |||
| 263 | } | |||||
| 264 | ||||||
| 265 | 1; | |||||