TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 100.0% (4/4)
Approximate LCSAJ segments: 13
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package App::Test::Generator::Analyzer::SideEffect; 2: 3: use strict; 4: use warnings; 5: 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: 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: 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: 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: =head1 VERSION 39: 40: Version 0.41 41: 42: =head1 DESCRIPTION 43: 44: Analyses the source body of a method and produces a side effect report 45: describing whether the method mutates C<$self>, mutates global state, 46: performs IO, or calls external commands. Used by 47: L<App::Test::Generator> to classify methods by purity and guide test 48: generation strategy. 49: 50: =head2 new 51: 52: Construct a new SideEffect analyser. 53: 54: my $analyser = App::Test::Generator::Analyzer::SideEffect->new; 55: 56: =head3 Arguments 57: 58: None. 59: 60: =head3 Returns 61: 62: A blessed hashref. 63: 64: =head3 API specification 65: 66: =head4 input 67: 68: {} 69: 70: =head4 output 71: 72: { 73: type => OBJECT, 74: isa => 'App::Test::Generator::Analyzer::SideEffect', 75: } 76: 77: =cut 78: 79: sub new { bless {}, shift } 80: 81: =head2 analyze 82: 83: Analyse the source body of a method and return a side effect report 84: hashref. 85: 86: my $analyser = App::Test::Generator::Analyzer::SideEffect->new; 87: my $report = $analyser->analyze($method); 88: 89: if ($report->{purity_level} eq 'pure') { 90: print "Method is side-effect free\n"; 91: } 92: 93: =head3 Arguments 94: 95: =over 4 96: 97: =item * C<$method> 98: 99: A hashref with a C<body> key containing the raw source text of the 100: method to analyse. 101: 102: =back 103: 104: =head3 Returns 105: 106: A hashref with the following keys: 107: 108: =over 4 109: 110: =item * C<mutates_self> — 1 if the method assigns to C<$self-E<gt>{field}>. 111: 112: =item * C<mutates_globals> — 1 if the method modifies global variables. 113: 114: =item * C<performs_io> — 1 if the method performs IO operations. 115: 116: =item * C<calls_external> — 1 if the method calls external commands. 117: 118: =item * C<mutation_fields> — arrayref of C<$self> field names assigned 119: to (deduplicated). 120: 121: =item * C<purity_level> — one of C<pure>, C<self_mutating>, or 122: C<impure>. 123: 124: =back 125: 126: =head3 Notes 127: 128: Detection is based on regex pattern matching against the raw source 129: text and will not catch dynamically constructed calls or aliased 130: operations. The global variable pattern covers common Perl specials 131: but is not exhaustive. 132: 133: =head3 API specification 134: 135: =head4 input 136: 137: { 138: self => { type => OBJECT, isa => 'App::Test::Generator::Analyzer::SideEffect' }, 139: method => { type => HASHREF }, 140: } 141: 142: =head4 output 143: 144: { 145: type => HASHREF, 146: keys => { 147: mutates_self => { type => SCALAR }, 148: mutates_globals => { type => SCALAR }, 149: performs_io => { type => SCALAR }, 150: calls_external => { type => SCALAR }, 151: mutation_fields => { type => ARRAYREF }, 152: purity_level => { type => SCALAR }, 153: }, 154: } 155: 156: =cut 157: 158: sub analyze { ●159 → 186 → 201 159: my ($self, $method) = @_; 160: 161: # Method argument is a raw hashref from SchemaExtractor 162: 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: my $code_only = _strip_strings_and_comments($body); 169: 170: 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: my %seen_fields; 186: while($code_only =~ /\$self->\{(\w+)\}\s*=/g) { 187: $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: push @{ $result{mutation_fields} }, $1Mutants (Total: 1, Killed: 1, Survived: 0)
192: 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.
Mutants (Total: 1, Killed: 1, Survived: 0)
200: # -------------------------------------------------- ●201 → 201 → 212 201: if($code_only =~ GLOBAL_PATTERN) { 202: $result{mutates_globals} = 1; 203: } 204: 205: # -------------------------------------------------- 206: # Detect IO operations — print, say, warn, open etc. 207: # Higher-level logging abstractions are not detected.
Mutants (Total: 1, Killed: 1, Survived: 0)
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 → 212 → 221 212: if($code_only =~ IO_PATTERN) { 213: $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 → 221 → 231 221: if($code_only =~ EXEC_PATTERN) { 222: $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: || $result{calls_external}; 234: 235: $result{purity_level} = 236: !$result{mutates_self} && !$has_external ? $PURITY_PURE : 237: $result{mutates_self} && !$has_external ? $PURITY_SELF_MUTATING : 238: $PURITY_IMPURE; 239: 240: 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: my ($body) = @_; 257: 258: $body =~ s/"(?:[^"\\]|\\.)*"//g; 259: $body =~ s/'(?:[^'\\]|\\.)*'//g; 260: $body =~ s/#.*$//mg; 261: 262: return $body; 263: } 264: 265: 1;