diff --git a/scripts/Makefile.am b/scripts/Makefile.am index df2fae42fce..ed18a81b375 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -28,6 +28,7 @@ dist_noinst_SCRIPTS += $(scripts_scripts) endif dist_noinst_DATA += \ + %D%/coverage_report.pl \ %D%/cstyle.pl \ %D%/update_authors.pl diff --git a/scripts/coverage_report.pl b/scripts/coverage_report.pl new file mode 100755 index 00000000000..ba8dec7a8d9 --- /dev/null +++ b/scripts/coverage_report.pl @@ -0,0 +1,392 @@ +#!/usr/bin/env perl + +# SPDX-License-Identifier: MIT +# +# Copyright (c) 2025, Rob Norris +# Copyright (c) 2026, TrueNAS. +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +# +# usage: coverage_report.pl tests/unit/test_zap.info +# coverage_report.pl < tests/unit/test_zap.info +# +# This program takes an lcov/geninfo coverage tracefile and shows a summary +# of line, branch and function coverage for each file. It's focused on the +# specific needs of OpenZFS' unit test suite (see tests/unit/README.md) but +# it should be adaptable to any place where lcov's HTML output is too heavy +# or difficult to use (eg build/CI logs). +# +# The heart of this program is a small parser for the tracefile format as +# described in geninfo(1). The rest is concerned with constructing a useful +# colorised table output. +# + +# +# Typical output: +# +# Coverage: test_zap | By line | By branch | By function +# | Rate% Total Hit | Rate% Total Hit | Rate% Total Hit +# module/zfs/u8_textprep.c | 42.0% 802 337 | 33.5% 510 171 | 50.0% 12 6 +# module/zfs/zap.c | 52.1% 687 358 | 45.2% 250 113 | 41.1% 90 37 +# module/zfs/zap_fat.c | 87.8% 665 584 | 58.5% 446 261 | 94.6% 37 35 +# module/zfs/zap_impl.c | 81.9% 232 190 | 60.3% 146 88 | 92.0% 25 23 +# module/zfs/zap_leaf.c | 86.7% 466 404 | 69.0% 216 149 | 95.7% 23 22 +# module/zfs/zap_micro.c | 76.5% 238 182 | 54.2% 142 77 | 92.9% 14 13 +# + +use 5.010; +use warnings; +use strict; +use Cwd qw(getcwd); +use Term::ANSIColor qw(colored); + +# Setup for color output. Perl has included Term::ANSIColor since 5.6 (~2000), +# but RGB support didn't arrive until v4 in 5.17.8 (~2012). We disable colors +# outright on versions < 4, or if output is not attached to a terminal. +my $use_colors = -t \*STDOUT && $Term::ANSIColor::VERSION >= 4; + +# Palette setup. If Term::ANSIColor and the terminal advertise support for +# it, then we set up a pleasant red -> green gradient for the coverage +# percentages. If not, we scale those colors down to the older RGB-240 colors +# (0-5 for each component), which is still quite nice. +my @palette = !$use_colors ? () : map { + state $has_truecolor = + $Term::ANSIColor::VERSION >= 5 && $ENV{COLORTERM}; + my @rgb = map { hex } m/../g; + if ($has_truecolor) { + sprintf 'r%dg%db%d', @rgb; + } else { + sprintf 'rgb%d%d%d', map { $_ * 6 / 255 } @rgb; + } +} ( + # Catppuccin Latte + # https://catppuccin.com/palette/ + 'd20f39', # Red + 'e64553', # Maroon + 'fe640b', # Peach + 'df8e1d', # Yellow + '40a02b', # Green + '179299', # Teal +); + +# Test name, from the TN: field if present. +my $test_name = ''; + +# Per-file data, initially sourced from the tracefile, then augmented +my %filedata; + +# Tracking for the longest (stringified) value for each key. These are used +# later when computing the output table column width. +my %len; +sub bump_len { + my ($k, $x) = @_; + my $l = length "".$x; + $len{$k} = $l if ($len{$k} // 0) < $l; +} + +### +# Parse the tracefile into per-file data records. + +# Current working directory. Expected to be the build root. Used to remove +# the leading part of the source filenames, so its not the end of the world +# if its wrong. +my $cwd = getcwd; + +# Loop over the input +while (my $line = <>) { + state $data = {}; + chomp $line; + + # skip comments + next if $line =~ m/^#/; + + if ($line eq 'end_of_record') { + # end of this file, prep for next + $data = {}; + next; + } + + # everything else should be a KEY:VALUE line + my ($k, $v) = $line =~ m/^([A-Z]+):(.*)$/; + unless (defined $k) { + say "W: $.: malformed line: $line"; + next; + } + + if ($k eq 'TN') { + # TN:test_zap + + # Test name. This is actually per-record (a tracefile can + # carry multiple test results) but we only ever generate + # them for a single test, so we don't make any effort to + # notice or track changes. + $test_name = $v; + next; + } + + if ($k eq 'SF') { + # SF:/home/robn/code/zfs-unit/module/zfs/zap.c + + # Source file. Value is the name, and the rest of the record + # apply to it. + + # Remove the leading build root name. + my $path = $v; + $path =~ s{^$cwd/*}{}; + + # If we haven't seen this file before, create a new data + # record for it. + $filedata{$v} //= { path => $path }; + $data = $filedata{$v}; + + # Increase path column width if necessary. + bump_len('path', $path); + next; + } + + # Handle the counter keys. These are single values for the entire + # record in the file. L, FN and BR are Line, Function and Branch, + # F and H are found (ie total) and hit (ie was executed). + if (grep { $_ eq $k } qw(LF LH FNF FNH BRF BRH)) { + $data->{lc $k} = $v; + bump_len(lc $k, $v); + next; + } + + # Older versions of lcov may not emit absolute found/hit counters. To + # handle this, we maintain our own counters from other events recorded + # in the info file, which we use if we don't get an absolute count. + + if ($k eq 'DA') { + # DA:,[,] + # DA:463,0 + # DA:469,153 + my ($l, $h) = split ',', $v; + + # One DA: record per actual code line (vs comment or other + # non-executable line), so we count records, not line number. + $data->{_lf}++; + + # Only increment the hit count if the line was executed. + $data->{_lh}++ if $h > 0; + next; + } + + if ($k eq 'FN') { + # FN:,[,] + # FN:283,zap_lookup_by_dnode + + # One FN record per function + $data->{_fnf}++; + next; + } + if ($k eq 'FNDA') { + # FNDA:, + # FNDA:0,zap_lookup + # FNDA:78,zap_lookup_by_dnode + + # Only count hit if more than one execution. + my ($c) = split ',', $v; + $data->{_fnh}++ if 0+$c > 0; + next; + } + + if ($k eq 'BRDA') { + # BRDA:,[],, + # BRDA:365,0,0,- + # BRDA:365,0,1,- + my ($l, $b, $br, $c) = split ',', $v; + + # One BRDA: record per branch + $data->{_brf}++; + + # is number of times branch arm was taken, or '-' if + # never considered (eg surrounding block was never entered) + # they're both 0 for our purposes. + $c = 0 if $c eq '-'; + + # Only count hit if more than one execution. + $data->{_brh}++ if 0+$c > 0; + next; + } +} + +### +# Synthesize missing counters + +for my $file (keys %filedata) { + my $data = $filedata{$file}; + + for my $k (qw(lf lh fnf fnh brf brh)) { + # Get our own count, if one exists. + my $v = delete $data->{"_$k"} // 0; + + # If we didn't find a count in the info file, use our own. + # Note that this will also set legitimately unseen values to + # 0 (eg a source file with no branches). That's actually what + # we want. + unless (exists $data->{$k}) { + $data->{$k} = $v; + bump_len($k, $v); + } + } +} + +### +# Synthesize the "rate" percentage field from the "found" and "hit" fields. + +sub rate { + my ($data, $k, $kf, $kh) = @_; + my $rate = sprintf '%.01f%%', + $data->{$kf} ? (100 * $data->{$kh} / $data->{$kf}) : 0; + $data->{$k} = $rate; + bump_len($k, $rate); +} + +for my $file (keys %filedata) { + my $data = $filedata{$file}; + rate($data, 'lr', 'lf', 'lh'); + rate($data, 'brr', 'brf', 'brh'); + rate($data, 'fnr', 'fnf', 'fnh'); +} + +### +# Set up the header "rows". + +# We reuse our data record structure a little because outputting these needs to +# consider and sometimes contribute to column width. + +# The top row spans multiple columns. The pad functions below have extra tools +# to handle the math. +my $h1data = { + path => 'Coverage'.($test_name ? ": $test_name" : ''), + l => 'By line', + br => 'By branch', + fn => 'By function', +}; +bump_len('path', $h1data->{path}); + +# The second row is the actual header for each data column, and so may push +# the column widths out if necessary. +my $h2data = { + lr => 'Rate%', lf => 'Total', lh => 'Hit', + brr => 'Rate%', brf => 'Total', brh => 'Hit', + fnr => 'Rate%', fnf => 'Total', fnh => 'Hit', +}; +bump_len($_, $h2data->{$_}) for keys %$h2data; + +### +# Table layout + +# Internal helper for padr() and padl() below. The idea is to compute the +# effective column width, and the string we want to place in it. If it would +# fit exactly, we return the string. If not, the passed-in function is called +# with the string, its length and the column width, and it will place it +# (by adding padding on either side). +# +# Most calls take a single column key, which makes it very simple - take +# the max width for that column (from %len, set by bump_len()), and the value +# of that key in this column, and that's all of it. +# +# For the top heading row (h1data above), a list of column keys can be passed +# in. In this case, the string will be constructed as a space-separated list +# of all the keys have have a value in the data row. The column width is the +# sum of max column widths for all columns that mave a max column width, plus +# one for each space separator. This allows us to provide a separate string +# to appear in the space, with the amount of space computed from the columns +# underneath it. +# +sub _pad { + my ($fn, $data, @k) = @_; + my $str = join ' ', map { $data->{$_} // () } @k; + my $strlen = length $str; + my $colwidth = -1; + $colwidth += ($len{$_} // -1)+1 for @k; + return $strlen == $colwidth ? $str : $fn->($str, $strlen, $colwidth); +} + +# Return the value of the named fields, with space-padding added to the right. +sub padr { + _pad(sub { + my ($str, $strlen, $colwidth) = @_; + $str . (' ' x ($colwidth - $strlen)); + }, @_); +} + +# Return the value of the named fields, with space-padding added to the left. +sub padl { + _pad(sub { + my ($str, $strlen, $colwidth) = @_; + (' ' x ($colwidth - $strlen)) . $str; + }, @_); +} + +# Return the given % string, wrapped in terminal control codes that will give +# it an appropriate color from the palette. +sub colorpct { + my ($pct) = @_; + + # If colors are disabled, return the string as-is. + return $pct unless $use_colors; + + my ($n) = $pct =~ m/([0-9\.]+)/; + + # scale 0-100 into palette range + my $s = int(($#palette / 100) * $n); + my $c = $palette[$s]; + + return colored([$c], $pct); +} + +my @rows; + +# Layout the first header row +push @rows, [ + padr($h1data, 'path'), + '|', padr($h1data, 'l', 'lr', 'lf', 'lh'), + '|', padr($h1data, 'br', 'brr', 'brf', 'brh'), + '|', padr($h1data, 'fn', 'fnr', 'fnf', 'fnh'), +]; + +# Layout the second header row +push @rows, [ + padr($h2data, 'path'), + '|', padr($h2data, 'lr'), padl($h2data, 'lf'), padl($h2data, 'lh'), + '|', padr($h2data, 'brr'), padl($h2data, 'brf'), padl($h2data, 'brh'), + '|', padr($h2data, 'fnr'), padl($h2data, 'fnf'), padl($h2data, 'fnh'), +]; + +# Layout the data rows, padding colorising as appropriate. +for my $file (sort keys %filedata) { + my $data = $filedata{$file}; + + push @rows, [ + padr($data, 'path'), + '|', colorpct(padl($data, 'lr')), + padl($data, 'lf'), padl($data, 'lh'), + '|', colorpct(padl($data, 'brr')), + padl($data, 'brf'), padl($data, 'brh'), + '|', colorpct(padl($data, 'fnr')), + padl($data, 'fnf'), padl($data, 'fnh'), + ]; +} + +# And print them all out! +say "@$_" for @rows;