CGI-Info
view release on metacpan or search on metacpan
azure-pipelines.yml view on Meta::CPAN
parameters:
debug: true
- template: templates/helpers/linux.yml@ci-perl-helpers
parameters:
coverage: codecov
debug: true
test_xt: true
use_default_perls: true
apt:
- locales
pre_test_steps:
# This is needed for the spelling test to pass. If run with LANG=C
# (the default absent an explicit setting), the test seems to read the
# <DATA> handle or the pod files incorrectly.
- bash: |
sudo locale-gen en_US.UTF-8
echo "##vso[task.setvariable variable=LANG]en_US.UTF-8"
echo "##vso[task.setvariable variable=LANGUAGE]en"
echo "##vso[task.setvariable variable=LC_ALL]en_US.UTF-8"
displayName: Set locale env vars
- template: templates/helpers/macos.yml@ci-perl-helpers
parameters:
debug: true
use_default_perls: true
- template: templates/helpers/windows.yml@ci-perl-helpers
parameters:
debug: true
use_default_perls: true
scripts/generate_index.pl 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/app-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:
scripts/generate_index.pl 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
scripts/generate_index.pl 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,
verbose => 1,
);
# --------------------------------------------------
# Parse command-line options.
# --generate_mutant_tests=dir enables test stub
# generation into the named directory.
# --generate_test=CLASS enables schema generation
# for surviving mutants.
# --generate_fuzz enables fuzz schema augmentation
scripts/generate_index.pl 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;
scripts/generate_index.pl 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} }
scripts/generate_index.pl 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,
scripts/generate_index.pl 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
scripts/generate_index.pl 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 {
scripts/generate_index.pl 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.723 second using v1.01-cache-2.11-cpan-ceb78f64989 )