App-Test-Generator
view release on metacpan or search on metacpan
stronger signals in the root causes table when multiple detectors
fire simultaneously.
- Added detect_universal_failure() root cause detector. Surfaces a
high-confidence warning when failures occur across 3 or more
distinct Perl versions and 2 or more OS types with fewer than
10% passing reports, indicating a likely broken release rather
than a version- or platform-specific compatibility issue. Likely
causes listed in evidence: missing file in tarball, broken
Makefile.PL, or undeclared dependency. Integrated into
detect_root_causes() where it is evaluated first and sorted by
confidence alongside the existing OS, locale, and Perl version
cliff detectors.
- Fixed blib/ paths appearing in coverage table instead of lib/
paths. Devel::Cover instruments blib/ during testing; paths are
now normalised to lib/ for display, with deduplication against
any native lib/ entry.
- Fixed structural coverage percentages in Executive Summary and
Structural Coverage sections showing ~24% instead of ~93%.
_coverage_totals now aggregates from individual own-project files
rather than Devel::Cover's pre-aggregated Total key which
includes all instrumented CPAN dependencies.
bin/test-generator-index view on Meta::CPAN
=item * B<LCSAJ path coverage> (TER3) from the LCSAJ runtime debugger,
showing which control-flow paths were executed. Displayed as blue
(covered) or red (uncovered) dots on per-file mutation pages.
=item * B<Mutation testing results> from C<bin/test-generator-mutate>,
showing which injected faults the test suite detected (killed) and
which it missed (survived).
=item * B<CPAN Testers failure analysis>, showing which Perl versions
and operating systems are failing, with automatic root cause detection
including Perl version cliffs, locale sensitivity, and dependency
version cliffs.
=back
In addition to the dashboard, the script drives the mutation-guided
test generation pipeline described in
L<App::Test::Generator/MUTATION-GUIDED TEST GENERATION>. Surviving
mutants are used to automatically generate new test stubs and fuzz
schemas that target the exact boundary conditions the test suite
missed:
bin/test-generator-index view on Meta::CPAN
=head1 DASHBOARD SECTIONS
Coverage Table - Per-file statement/branch/condition/subroutine
percentages with delta vs previous snapshot,
sortable columns, and sparkline trend per file
Coverage Trend - Chart of total coverage over recent commits with
linear regression line, zoom and pan support
RT Issues - Count of open RT tickets for the distribution
CPAN Testers - Failure table for the current release, with
Perl version cliff detection, locale analysis,
dependency version cliff detection, and root
cause confidence scoring
Mutation Report - Per-file mutation score (killed/survived/total),
cyclomatic complexity, and TER3 (LCSAJ path
coverage) with raw fraction
Per-file Pages - Line-by-line mutation heatmap with TER1/TER2/TER3
metrics, LCSAJ path markers, and expandable
mutant details with suggested tests
=head1 DEPENDENCIES
bin/test-generator-index view on Meta::CPAN
med_threshold => 90,
max_points => 10, # Only display the last 10 commits in the coverage trend graph
cover_db => 'cover_html/cover.json', # Devel::Cover JSON output
mutation_db => 'mutation.json',
mutation_dir => 'coverage/mutation_html', # hrefs in published pages
mutation_output_dir => 'cover_html/mutation_html', # where files are written
lcsaj_root => 'cover_html/mutation_html/lib',
lcsaj_hits_file => 'cover_html/lcsaj_hits.json', # Runtime.pm writes here
output => 'cover_html/index.html', # published to gh-pages
max_retry => 5,
min_locale_samples => 3,
module_file => 'lib/App/Test/Generator.pm',
verbose => 1,
);
# --------------------------------------------------
# HTTP and retry constants
# --------------------------------------------------
# HTTP status code returned by HTTP::Tiny when the
# connection itself fails (as opposed to a server error)
bin/test-generator-index view on Meta::CPAN
border: 1px solid #ffeeba;
color: #856404;
}
.notice.perl-version-cliff a {
color: #533f03;
text-decoration: underline;
}
.notice.perl-version-cliff a:hover {
text-decoration: none;
}
.notice.locale-cliff {
border-left: 4px solid #d97706;
background: #fffbeb;
padding: 0.5em 1em;
}
.notice.rt-issues {
background: #fff6e5;
border-left: 4px solid #d9822b;
}
table.root-causes {
border-collapse: collapse;
bin/test-generator-index view on Meta::CPAN
}
push @html, '<h3>Failure Summary (all reports)</h3>';
push @html, '<ul>';
my %clusters = (
perl_series => {},
os => {},
perl_os => {},
);
my %locale_stats;
for my $r (@fail_reports) {
my $perl = perl_series($r->{perl});
my $os = $r->{osname} // 'unknown';
$clusters{perl_series}{$perl}++ if $perl;
$clusters{os}{$os}++;
$clusters{perl_os}{"$perl / $os"}++ if $perl;
if(lc($r->{grade} // '') eq 'fail') {
# Don't include NA or Unknown in this list
my $locale = extract_locale($r) // 'unknown';
$locale_stats{$locale}{fail}++;
}
}
my @top_perl_series = sort { $clusters{perl_series}{$b} <=> $clusters{perl_series}{$a} }
keys %{ $clusters{perl_series} };
my @top_os = sort { $clusters{os}{$b} <=> $clusters{os}{$a} }
keys %{ $clusters{os} };
my @top_perl_os = sort { $clusters{perl_os}{$b} <=> $clusters{perl_os}{$a} }
bin/test-generator-index view on Meta::CPAN
my $k = $top_perl_os[0];
push @html, sprintf(
'<li><b>%s</b>: %d failures</li>',
$k,
$clusters{perl_os}{$k},
);
}
push @html, '</ul>';
my @locale_clusters;
for my $r (@pass_reports) {
my $locale = extract_locale($r) // 'unknown';
$locale_stats{$locale}{pass}++;
}
for my $loc (keys %locale_stats) {
next if $loc eq 'unknown';
my $fail = $locale_stats{$loc}{fail} // 0;
my $pass = $locale_stats{$loc}{pass} // 0;
my $total = $fail + $pass;
next if $total < $config{min_locale_samples};
my $ratio = $fail / $total * 100;
if($ratio >= $config{low_threshold} && is_non_english_locale($loc)) {
push @locale_clusters, {
locale => $loc,
fail => $fail,
pass => $pass,
ratio => $ratio,
};
}
}
if(scalar(@locale_clusters)) {
push @html,
'<h3>Locale-sensitive failures detected</h3>',
'<div class="notice locale-cliff">',
'<ul>';
foreach my $locale(@locale_clusters) {
push @html, "<li><code>$locale->{locale}</code> - $locale->{fail} FAIL / $locale->{pass} PASS ($locale->{ratio}%)</li>";
}
push @html, '</ul>', '</div>';
}
my @fail_perl_versions = extract_perl_versions(\@fail_reports);
my @pass_perl_versions = extract_perl_versions(\@pass_reports);
my @root_causes = detect_root_causes(
fail_reports => \@fail_reports,
pass_reports => \@pass_reports,
bin/test-generator-index view on Meta::CPAN
my $perl = $_[0];
return unless defined $perl;
# map "5.16.3" to "5.16"
if($perl =~ /^(\d+\.\d+)/) {
return $1;
}
return;
}
sub extract_locale {
my $r = $_[0];
# Preferred: explicit environment
for my $k (qw(LANG LC_ALL LC_CTYPE)) {
if(my $v = $r->{env}{$k}) {
return $v;
}
}
# Fallback: scan report body
bin/test-generator-index view on Meta::CPAN
my $res = $http->get($url);
return unless $res->{success};
my $report = eval { decode_json($res->{content}) };
if($report->{result}->{output}->{uncategorized} =~ /\b([a-z]{2}_[A-Z]{2})\b/) {
return $1;
}
}
sub is_non_english_locale {
my $locale = $_[0];
return 0 unless $locale;
# Treat C / POSIX / en_* as English
return 0 if $locale =~ /^(C|POSIX|en(_|$))/i;
return 1;
}
sub parse_version {
my $v = $_[0];
return eval { version->parse($v) };
}
sub fetch_open_rt_ticket_count {
bin/test-generator-index view on Meta::CPAN
label => "Perl version regression (Perl < $min_pass)",
confidence => 1.00,
evidence => [
"All failures on Perl ≤ $max_fail",
"All passes on Perl ≥ $min_pass",
],
perldelta => perldelta_url($min_pass),
};
}
sub detect_locale_root_cause {
my ($reports, $config) = @_;
my %count;
my $total = 0;
for my $r (@$reports) {
# Can get FPs if we take NA or Unknown into account
if(lc($r->{grade} // '') eq 'fail') {
my $loc = extract_locale($r) or next;
next if $loc =~ /^en_/i;
$count{$loc}++;
$total++;
}
}
return unless $total >= 2;
for my $loc (keys %count) {
my $ratio = $count{$loc} / $total;
next unless $ratio >= ($config->{low_threshold} / 100);
return {
type => 'locale',
label => "Locale-sensitive behavior ($loc)",
confidence => sprintf("%.2f", $ratio),
evidence => [
"$count{$loc}/$total failures with LANG=$loc",
'English locales show fewer or no failures',
],
};
}
return;
}
sub detect_root_causes {
my (%args) = @_;
my @hints;
# Check for universal failure pattern first — if present,
# it is almost certainly the most important root cause
push @hints, detect_universal_failure(
$args{fail_reports} || [],
$args{pass_reports} || [],
);
push @hints, detect_os_root_cause($args{fail_reports}, \%config) if $args{fail_reports};
push @hints, detect_locale_root_cause($args{fail_reports}, \%config);
if($args{fail_perl_versions} && $args{pass_perl_versions}) {
push @hints,
detect_perl_version_root_cause(
$args{fail_perl_versions},
$args{pass_perl_versions},
);
}
push @hints, detect_scattered_failures(
( run in 0.706 second using v1.01-cache-2.11-cpan-5735350b133 )