TER1 (Statement): 100.00%
TER2 (Branch): 86.36%
TER3 (LCSAJ): 100.0% (11/11)
Approximate LCSAJ segments: 23
● 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::LCSAJ; 2: 3: use strict; 4: use warnings; 5: use Carp qw(croak); 6: use File::Basename qw(basename); 7: use File::Path qw(make_path); 8: use File::Spec; 9: use JSON::MaybeXS; 10: use PPI; 11: use Readonly; 12: 13: # -------------------------------------------------- 14: # Default output directory for LCSAJ JSON files 15: # -------------------------------------------------- 16: Readonly my $DEFAULT_OUT_DIR => 'lcsaj'; 17: 18: our $VERSION = '0.36'; 19: 20: =head1 NAME 21: 22: App::Test::Generator::LCSAJ - Static LCSAJ extraction for Perl 23: 24: =head1 SYNOPSIS 25: 26: use App::Test::Generator::LCSAJ; 27: 28: my $paths = App::Test::Generator::LCSAJ->generate( 29: 'lib/MyModule.pm', 30: 'cover_html/mutation_html/lib', 31: ); 32: 33: =head1 DESCRIPTION 34: 35: Extracts Linear Code Sequence and Jump (LCSAJ) paths from Perl source 36: files using static analysis via L<PPI>. Each LCSAJ path describes a 37: linear sequence of statements followed by a jump to another sequence, 38: forming the basis for TER3 (third-level Test Effectiveness Ratio) 39: measurement. 40: 41: The extracted paths are written as JSON to a C<.lcsaj.json> file under 42: the output directory, where they are consumed by 43: C<bin/test-generator-index> for dashboard display and TER3 44: calculation. 45: 46: =head1 VERSION 47: 48: Version 0.36 49: 50: =head2 generate 51: 52: Extract LCSAJ paths from all subroutines in a Perl source file and 53: write the results to a JSON file. 54: 55: my $paths = App::Test::Generator::LCSAJ->generate( 56: 'lib/MyModule.pm', 57: 'cover_html/mutation_html/lib', 58: ); 59: 60: printf "Extracted %d LCSAJ paths\n", scalar @{$paths}; 61: 62: =head3 Arguments 63: 64: =over 4 65: 66: =item * C<$file> 67: 68: Path to the Perl source file to analyse. Required. 69: 70: =item * C<$out_dir> 71: 72: Directory under which the C<.lcsaj.json> file will be written. 73: Optional — defaults to C<lcsaj>. 74: 75: =back 76: 77: =head3 Returns 78: 79: An arrayref of LCSAJ path hashrefs, each with keys C<start>, C<end>, 80: and C<target> representing the first line, last line, and jump target 81: line of the path respectively. 82: 83: =head3 Side effects 84: 85: Creates C<$out_dir> if it does not exist. Writes a C<.lcsaj.json> 86: file to C<$out_dir>. 87: 88: =head3 Notes 89: 90: Only named subroutines are analysed. Anonymous subs and file-level 91: code are not included. The control flow graph is built using a 92: simplified model that treats branching compound statements as 93: split points — complex nested structures may not be fully represented. 94: 95: =head3 API specification 96: 97: =head4 input 98: 99: { 100: class => { type => SCALAR }, 101: file => { type => SCALAR }, 102: out_dir => { type => SCALAR, optional => 1 }, 103: } 104: 105: =head4 output 106: 107: { 108: type => ARRAYREF, 109: elements => { 110: type => HASHREF, 111: keys => { 112: start => { type => SCALAR }, 113: end => { type => SCALAR }, 114: target => { type => SCALAR }, 115: }, 116: }, 117: } 118: 119: =cut 120: 121: sub generate { ●122 → 135 → 145●122 → 135 → 0 122: my ($class, $file, $out_dir) = @_; 123: 124: # Apply default output directory if not supplied 125: $out_dir //= $DEFAULT_OUT_DIR; 126: 127: # Parse the source file — croak early with a clear message 128: my $doc = PPI::Document->new($file) or croak "Cannot parse $file"; 129: 130: # Find all named subroutines in the document 131: my $subs = $doc->find('PPI::Statement::Sub') || []; 132: 133: my @all_paths; 134: 135: for my $sub (@{$subs}) { 136: # Build a simplified control flow graph for this sub 137: my $blocks = _build_cfg($sub); 138: 139: # Convert the CFG to LCSAJ path records 140: my $paths = _cfg_to_lcsaj($blocks); 141: push @all_paths, @{$paths}; 142: } 143: 144: # Write all extracted paths to a JSON file in the output directory ●145 → 147 → 0 145: _save_lcsaj($file, $out_dir, \@all_paths); 146: 147: return \@all_paths; 148: } 149: 150: # -------------------------------------------------- 151: # _build_cfg 152: # 153: # Purpose: Build a simplified control flow graph 154: # (CFG) for a single subroutine. Each 155: # block in the CFG represents a linear 156: # sequence of statements terminated by a 157: # branch or the end of the sub. 158: # 159: # Entry: $sub - a PPI::Statement::Sub node. 160: # 161: # Exit: Returns an arrayref of block hashrefs, 162: # each with keys id, lines, and edges. 163: # Returns an empty arrayref if the sub 164: # has no body. 165: # 166: # Side effects: None. 167: # 168: # Notes: Only compound statements (if, unless, 169: # while, for, foreach) are treated as 170: # branch points. Complex nested structures 171: # may not be fully represented. 172: # -------------------------------------------------- 173: sub _build_cfg { ●174 → 184 → 204●174 → 184 → 0 174: my $sub = $_[0]; 175: 176: # Return empty graph if the sub has no body block 177: my $block = $sub->block() or return []; 178: 179: my @statements = $block->schildren(); 180: my @blocks; 181: my $id = 1; 182: my $current = _new_block($id); 183: 184: for my $stmt (@statements) { 185: my $line = $stmt->line_number; 186: push @{ $current->{lines} }, $line; 187: 188: # Branch points split the current block and start two new ones 189: if(_is_branch($stmt)) {Mutants (Total: 1, Killed: 1, Survived: 0)
190: push @blocks, $current; 191: 192: # Create true and false successor blocks 193: my $true_block = _new_block(++$id); 194: my $false_block = _new_block(++$id); 195: _connect_blocks($current, $true_block); 196: _connect_blocks($current, $false_block); 197: 198: push @blocks, $true_block, $false_block; 199: $current = $true_block; 200: } 201: } 202: 203: # Append the final block after all statements are processed ●204 → 208 → 213●204 → 208 → 0 204: push @blocks, $current; 205: 206: # Connect sequential fallthrough edges between adjacent blocks 207: # that have no outgoing edges yet 208: for(my $i = 0; $i < $#blocks; $i++) {
Mutants (Total: 3, Killed: 3, Survived: 0)
209: next if @{ $blocks[$i]{edges} }; 210: _connect_blocks($blocks[$i], $blocks[$i + 1]); 211: } 212: ●213 → 213 → 0 213: return \@blocks; 214: } 215: 216: # -------------------------------------------------- 217: # _new_block 218: # 219: # Purpose: Construct a new CFG block hashref with 220: # an id, empty lines list, and empty 221: # edges list. 222: # 223: # Entry: $id - integer block identifier. 224: # Exit: Returns a hashref. 225: # Side effects: None. 226: # -------------------------------------------------- 227: sub _new_block { 228: my $id = $_[0]; 229: 230: return { id => $id, lines => [], edges => [] }; 231: } 232: 233: # -------------------------------------------------- 234: # _connect_blocks 235: # 236: # Purpose: Add a directed edge from one CFG block 237: # to another by recording the target 238: # block's id in the source block's edges. 239: # 240: # Entry: $from - source block hashref. 241: # $to - target block hashref. 242: # Exit: Modifies $from->{edges} in place. 243: # Side effects: Modifies $from. 244: # -------------------------------------------------- 245: sub _connect_blocks { 246: my ($from, $to) = @_; 247: push @{ $from->{edges} }, $to->{id}; 248: } 249: 250: # -------------------------------------------------- 251: # _is_branch 252: # 253: # Purpose: Return true if a PPI statement node 254: # represents a branching control structure 255: # that should split the current CFG block. 256: # 257: # Entry: $stmt - a PPI::Statement node. 258: # Exit: Returns 1 if the statement is a branch, 259: # 0 otherwise. 260: # Side effects: None. 261: # Notes: Only compound statement types are 262: # considered — simple expressions are not. 263: # -------------------------------------------------- 264: sub _is_branch { 265: my $stmt = $_[0]; 266: 267: # Only compound statements can be branch points 268: return 0 unless $stmt->isa('PPI::Statement::Compound');
Mutants (Total: 2, Killed: 2, Survived: 0)
269: 270: my $type = $stmt->type // ''; 271: return $type =~ /^(?:if|unless|while|for|foreach)$/ ? 1 : 0;
Mutants (Total: 2, Killed: 2, Survived: 0)
272: } 273: 274: # -------------------------------------------------- 275: # _cfg_to_lcsaj 276: # 277: # Purpose: Convert a CFG block list into a list of 278: # LCSAJ path records. Each path represents 279: # one linear sequence from a block's first 280: # line to its last line, with a jump to 281: # the first line of the target block. 282: # 283: # Entry: $blocks - arrayref of CFG block hashrefs 284: # as produced by _build_cfg. 285: # 286: # Exit: Returns an arrayref of path hashrefs, 287: # each with keys start, end, and target. 288: # 289: # Side effects: None. 290: # 291: # Notes: Blocks with no lines (empty blocks) are 292: # excluded from the id-to-line mapping and 293: # their target lines default to 0. 294: # -------------------------------------------------- 295: sub _cfg_to_lcsaj { ●296 → 304 → 321●296 → 304 → 0 296: my $blocks = $_[0]; 297: 298: # Build a lookup from block id to its first line number 299: my %id2line = map { $_->{id} => $_->{lines}[0] } 300: grep { @{ $_->{lines} } } @{$blocks}; 301: 302: my @paths; 303: 304: for my $b (@{$blocks}) { 305: next unless @{ $b->{edges} }; # Skip blocks with no outgoing edges — they are leaf nodes 306: next unless @{ $b->{lines} }; # skip empty blocks — avoids null-bounds paths 307: 308: my $start = $b->{lines}[0]; 309: my $end = $b->{lines}[-1]; 310: 311: # Emit one path record per outgoing edge 312: for my $target_id (@{ $b->{edges} }) { 313: push @paths, { 314: start => $start, 315: end => $end, 316: target => $id2line{$target_id} // 0, 317: }; 318: } 319: } 320: ●321 → 321 → 0 321: return \@paths; 322: } 323: 324: # -------------------------------------------------- 325: # _save_lcsaj 326: # 327: # Purpose: Serialise LCSAJ path records to a JSON 328: # file in the output directory. The 329: # filename is derived from the source 330: # file's basename. 331: # 332: # Entry: $file - path to the source .pm file. 333: # $dir - output directory path. 334: # $paths - arrayref of path hashrefs. 335: # 336: # Exit: Returns nothing. Writes a .lcsaj.json 337: # file to $dir. 338: # 339: # Side effects: Creates $dir if it does not exist. 340: # Writes a file to $dir. 341: # 342: # Notes: Uses File::Basename::basename for 343: # portability across operating systems. 344: # -------------------------------------------------- 345: sub _save_lcsaj { 346: my ($file, $dir, $paths) = @_; 347: 348: # Derive the module-relative path (strip leading .../lib/ prefix) 349: my $rel = $file; 350: 351: # Strip leading path up to and including 'lib/' — handles both 352: # absolute paths (/home/runner/.../lib/App/...) and relative (lib/App/...) 353: # Handle both Unix / and Windows \ separators 354: $rel =~ s{^(?:.*[/\\])?lib[/\\]}{}; 355: 356: my $base = basename($rel); 357: 358: # Mirror the directory structure expected by _lcsaj_coverage_for_file: 359: # $dir / $rel.lcsaj / $base.lcsaj.json 360: my $subdir = File::Spec->catfile($dir, "$rel.lcsaj"); 361: 362: # Create the output directory if it does not exist 363: make_path($subdir) unless -d $subdir; 364: my $out = File::Spec->catfile($subdir, "$base.lcsaj.json"); 365: 366: # Remove degenerate paths (null bounds) and exact duplicates 367: # before serialising — guards against empty CFG blocks producing 368: # null start/end values, and branch splits creating identical records 369: my %seen; 370: my @clean = grep { 371: defined $_->{start} && defined $_->{end} 372: && !$seen{"$_->{start}:$_->{end}:$_->{target}"}++ 373: } @{$paths}; 374: 375: open my $fh, '>', $out or croak "Cannot write LCSAJ output to $out: $!"; 376: print $fh encode_json(\@clean); 377: close $fh; 378: } 379: 380: 1;