Skip to content

Commit 1162c01

Browse files
henry2coxhenry2cox
committed
Improved 'other language' support.
Enable exclusions and substitutions in perl2lcov. Warn if coverage DB is empty. Signed-off-by: Henry Cox <[email protected]>
1 parent 9973d3c commit 1162c01

File tree

5 files changed

+99
-84
lines changed

5 files changed

+99
-84
lines changed

‎bin/perl2lcov

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ For example:
8484
# data into a usable form. This will also generate an HTML report
8585
# in 'myCoverDB'
8686
\$ cover myCoverDB -silent 1
87-
# run perl2lcov transtor to produce LCOV format data:
87+
# run perl2lcov translator to produce LCOV format data:
8888
\$ perl2lcov -o perldata.info [--testname myTestName] myCoverDB
8989
# and generate a genhtml-format coverage report:
9090
\$ genhtml -o html_report perldata.info ...
@@ -126,10 +126,10 @@ $lcovutil::func_coverage = 1;
126126
$lcovutil::derive_function_end_line = 1;
127127
$lcovutil::derive_end_line_all_files = 1;
128128
lcovutil::save_cmd_line(\@ARGV, "$FindBin::RealBin");
129+
lcovutil::set_extensions('perl', '.*');
129130

130131
my $testname = '';
131132
my $output_file = 'perlcov.info';
132-
our %rc_options;
133133
our %options = ('testname=s' => \$testname,
134134
'output|o=s' => \$output_file,);
135135
if (!lcovutil::parseOptions({}, \%options)) {
@@ -142,12 +142,26 @@ my $info = TraceFile->new();
142142
foreach my $db (@ARGV) {
143143
# parse the other files first - to grab the data we want -
144144
# Not quite sure how to map 'cond' to LCOV branch coverage.
145+
146+
# save a readable message before remapping the $db
147+
my $msg =
148+
"$db appears to be empty; perhaps you need to run 'cover $db' before executing $0.";
145149
my $db = Devel::Cover::DB->new(db => $db);
146150
my $cover = $db->cover;
151+
my @items = $cover->items;
152+
if (!@items) {
153+
lcovutil::ignorable_error($lcovutil::ERROR_EMPTY, $msg);
154+
next;
155+
}
147156
foreach my $file ($cover->items) {
148-
lcovutil::info("process $file\n");
157+
my $filename = lcovutil::subst_file_name($file);
158+
lcovutil::info("process $filename" .
159+
($filename ne $file ? " (substituted from $file)" : '') . "\n");
160+
if (TraceFile::skipCurrentFile($filename)) {
161+
lcovutil::info(" (excluded)\n");
162+
next;
163+
}
149164
my $f = $cover->file($file);
150-
151165
my $fileData =
152166
$info->data($file); # really, want to use stored file name
153167
my $functionMap = $fileData->testfnc($testname);

‎lib/lcovutil.pm

Lines changed: 37 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -815,7 +815,7 @@ sub save_profile($)
815815
sub set_extensions
816816
{
817817
my ($type, $str) = @_;
818-
die("unknown language '$type'") unless exits($languageExtensions{$type});
818+
die("unknown language '$type'") unless exists($languageExtensions{$type});
819819
$languageExtensions{$type} = join('|', split($split_char, $str));
820820
}
821821

@@ -5063,6 +5063,12 @@ sub filename
50635063
return $_[0]->[FILENAME];
50645064
}
50655065

5066+
sub numLines
5067+
{
5068+
my $self = shift;
5069+
return scalar(@{$self->[SOURCE]});
5070+
}
5071+
50665072
sub getLine
50675073
{
50685074
my ($self, $line) = @_;
@@ -5816,8 +5822,11 @@ sub _filterFile
58165822
++$remove->[0]; # one line where we skip
58175823
$remove->[1] += ($brdata->totals())[0];
58185824
lcovutil::info(2,
5819-
"filter BRDA '" .
5820-
$srcReader->getLine($line) .
5825+
"filter BRDA '"
5826+
.
5827+
($line < $srcReader->numLines() ?
5828+
$srcReader->getLine($line) :
5829+
'<-->') .
58215830
"' $source_file:$line\n");
58225831
# now remove this branch everywhere...
58235832
foreach my $tn ($testbrdata->keylist()) {
@@ -5882,7 +5891,7 @@ sub _filterFile
58825891
lcovutil::info(2,
58835892
"filter DA "
58845893
.
5885-
(defined($srcReader->getLine($line)) ?
5894+
($line < $srcReader->numLines() ?
58865895
("'" . $srcReader->getLine($line) . "'") :
58875896
"") .
58885897
" $source_file:$line\n");
@@ -6486,10 +6495,13 @@ sub applyFilters
64866495
sub is_language
64876496
{
64886497
my ($lang, $filename) = @_;
6498+
my $idx = index($filename, '.');
6499+
my $ext = $idx == -1 ? '' : substr($filename, $idx + 1);
64896500
foreach my $l (split('\|', $lang)) {
64906501
die("unknown language '$l'")
64916502
unless exists($lcovutil::languageExtensions{$l});
6492-
return 1 if $filename =~ /\.($lcovutil::languageExtensions{$l})$/;
6503+
my $extensions = $lcovutil::languageExtensions{$l};
6504+
return 1 if ($ext =~ /($extensions)/);
64936505
}
64946506
return 0;
64956507
}
@@ -6585,7 +6597,7 @@ sub _read_info
65856597
# The hack is to put branches into a hash keyed by branch ID - and
65866598
# merge elements with the same key if we run into them in the multiple
65876599
# times in the same 'file' data (within an SF entry).
6588-
my %branchRenumber; # line -> block -> branch -> branchentry
6600+
my %nextBranchId; # line -> integer ID
65896601
my ($currentBranchLine, $skipBranch);
65906602
my $functionMap;
65916603
my %excludedFunction;
@@ -6618,7 +6630,7 @@ sub _read_info
66186630
}
66196631

66206632
# Retrieve data for new entry
6621-
%branchRenumber = ();
6633+
%nextBranchId = ();
66226634
%excludedFunction = ();
66236635

66246636
if ($verify_checksum) {
@@ -6815,8 +6827,6 @@ sub _read_info
68156827
my $comma = rindex($d, ',');
68166828
my $taken = substr($d, $comma + 1);
68176829
my $expr = substr($d, 0, $comma);
6818-
# hold line, block, expr etc - to process when we get to end of file
6819-
# (for parallelism support...)
68206830

68216831
# Notes:
68226832
# - there may be other branches on the same line (..the next
@@ -6837,43 +6847,20 @@ sub _read_info
68376847
# generate an CNF or truth-table like entry corresponding
68386848
# to the branch.
68396849

6840-
if (!is_language('c', $filename)) {
6841-
# At least at present, Verilog/SystemVerilog/VHDL,
6842-
# java, python, etc don't need branch number fixing
6843-
my $key = "$line,$block";
6844-
my $branch =
6845-
exists($branchRenumber{$key}) ?
6846-
$branchRenumber{$key} :
6847-
0;
6848-
$branchRenumber{$key} = $branch + 1;
6849-
6850-
my $br =
6851-
BranchBlock->new($branch, $taken, $expr, $is_exception);
6852-
$fileData->sumbr()->append($line, $block, $br, $filename);
6853-
6854-
# Add test-specific counts
6855-
if (defined($testname)) {
6856-
$fileData->testbr($testname)
6857-
->append($line, $block, $br, $filename);
6858-
}
6859-
} else {
6860-
# only C code might need renumbering - but this
6861-
# is an artifact of some very old geninfo code,
6862-
# so any new data files will be OK
6863-
$branchRenumber{$line} = {}
6864-
unless exists($branchRenumber{$line});
6865-
$branchRenumber{$line}->{$block} = {}
6866-
unless exists($branchRenumber{$line}->{$block});
6867-
my $table = $branchRenumber{$line}->{$block};
6868-
6869-
my $entry =
6870-
BranchBlock->new($expr, $taken, $expr, $is_exception);
6871-
if (exists($table->{$expr})) {
6872-
# merge
6873-
$table->{$expr}->merge($entry, $filename, $line);
6874-
} else {
6875-
$table->{$expr} = $entry;
6876-
}
6850+
my $key = "$line,$block";
6851+
my $branch =
6852+
exists($nextBranchId{$key}) ? $nextBranchId{$key} :
6853+
0;
6854+
$nextBranchId{$key} = $branch + 1;
6855+
6856+
my $br =
6857+
BranchBlock->new($branch, $taken, $expr, $is_exception);
6858+
$fileData->sumbr()->append($line, $block, $br, $filename);
6859+
6860+
# Add test-specific counts
6861+
if (defined($testname)) {
6862+
$fileData->testbr($testname)
6863+
->append($line, $block, $br, $filename);
68776864
}
68786865
last;
68796866
};
@@ -6888,36 +6875,6 @@ sub _read_info
68886875
$fileData->version($version)
68896876
if (defined($version) && $version ne "");
68906877
}
6891-
if (is_language('c', $filename)) {
6892-
# RTL code was added directly - no issue with
6893-
# duplicate data entries in geninfo result
6894-
my $testcaseBranchData = $fileData->testbr($testname)
6895-
if defined($testname);
6896-
while (my ($line, $l_data) = each(%branchRenumber)) {
6897-
foreach my $block (sort { $a <=> $b }
6898-
keys(%$l_data)
6899-
) {
6900-
my $bdata = $l_data->{$block};
6901-
my $branchId = 0;
6902-
foreach my $b_id (sort { $a <=> $b }
6903-
keys(%$bdata)
6904-
) {
6905-
my $br = $bdata->{$b_id};
6906-
my $b =
6907-
BranchBlock->new($branchId, $br->data(),
6908-
undef, $br->is_exception());
6909-
$fileData->sumbr()
6910-
->append($line, $block, $b, $filename);
6911-
6912-
if (defined($testcaseBranchData)) {
6913-
$testcaseBranchData->append($line,
6914-
$block, $b, $filename);
6915-
}
6916-
++$branchId;
6917-
}
6918-
}
6919-
}
6920-
} # end "if (! rtl)"
69216878
if ($lcovutil::func_coverage) {
69226879

69236880
if ($funcdata != $functionMap) {
@@ -6996,6 +6953,10 @@ sub write_info_file($$$)
69966953
{
69976954
my ($self, $filename, $do_checksum) = @_;
69986955

6956+
if ($self->empty()) {
6957+
lcovutil::ignorable_error($lcovutil::ERROR_EMPTY,
6958+
"coverage DB is empty");
6959+
}
69996960
my $file = InOutFile->out($filename);
70006961
my $hdl = $file->hdl();
70016962
$self->write_info($hdl, $do_checksum);

‎tests/Makefile

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,11 +23,12 @@ report:
2323
$(SPREADSHEET_TOOL) -o report.xlsx `find . -name "*.json"`
2424
if [ "x$(COVERAGE)" != 'x' ] ; then \
2525
cover $(COVER_DB) ; \
26-
$(BINDIR)/perl2lcov -o perlcov.info $(COVER_DB) --version-script $(VERSION_SCRIPT) ; \
26+
$(BINDIR)/perl2lcov -o perlcov.info $(COVER_DB) --version-script $(VERSION_SCRIPT) --exclude 'filter.pl' --ignore unsupported ; \
2727
if [ -f $(PYCOV_DB) ] ; then \
2828
$(BINDIR)/py2lcov -o pycov.info $(PYCOV_DB) --version-script $(VERSION_SCRIPT) ; \
2929
fi ; \
30-
$(BINDIR)/genhtml --parallel -o $(HTML_RPT) perlcov.info pycov.i* $(COVER_DB)/*.info --show-navigation --flat --branch --show-proportion --version-script $(VERSION_SCRIPT) --annotate-script $(ANNOTATE_SCRIPT) --ignore empty,inconsistent ; \
30+
$(BINDIR)/genhtml --parallel -o $(HTML_RPT) perlcov.info pycov.info --show-navigation --flat --branch --show-proportion --version-script $(VERSION_SCRIPT) --annotate-script $(ANNOTATE_SCRIPT) --ignore empty,inconsistent ; \
31+
cp p*cov.info $(HTML_RPT) ; \
3132
echo "Wrote HTML report to ${HTML_RPT}" ; \
3233
fi
3334

‎tests/gendiffcov/synthesize/synthesize.sh

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ while [ $# -gt 0 ] ; do
3535
LOCAL_COVERAGE=0
3636
shift
3737
fi
38-
COVER="perl -MDevel::Cover=-db,${COVER_DB},-coverage,statement,branch,condition,subroutine "
38+
COVER="perl -MDevel::Cover=-db,${COVER_DB},-coverage,statement,branch,condition,subroutine,-silent,1 "
3939
;;
4040

4141
--home | -home )
@@ -92,6 +92,7 @@ if [ 'x' == "x$GENHTML_TOOL" ] ; then
9292
GENHTML_TOOL=${LCOV_HOME}/bin/genhtml
9393
LCOV_TOOL=${LCOV_HOME}/bin/lcov
9494
GENINFO_TOOL=${LCOV_HOME}/bin/geninfo
95+
PERL2LCOV_TOOL=${LCOV_HOME}/bin/perl2lcov
9596
fi
9697

9798
ROOT=`pwd`
@@ -109,6 +110,7 @@ rm -rf ./vanilla ./annotated annotateErr ./range ./filter ./cover_db
109110

110111
if [ "x$COVER" != 'x' ] && [ 0 != $LOCAL_COVERAGE ] ; then
111112
cover -delete
113+
rm -rf coverage
112114
fi
113115

114116
if [[ 1 == $CLEAN_ONLY ]] ; then
@@ -259,5 +261,7 @@ fi
259261
echo "Tests passed"
260262
261263
if [ "x$COVER" != "x" ] && [ 0 != $LOCAL_COVERAGE ] ; then
262-
cover
264+
cover $COVER_DB
265+
$PERL2LCOV_TOOL -o perlcov.info $COVER_DB
266+
$GENHTML_TOOL -o coverage perlcov.info
263267
fi

‎tests/perl2lcov/perltest1.sh

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,11 +104,25 @@ if [ 0 != $? ] ; then
104104
echo "perl exec failed"
105105
exit 1
106106
fi
107+
108+
# error check: try to run perl2lcov before running 'cover':
109+
$COVER ${EXEC_COVER} $PERL2LCOV_TOOL --output err.info --testname test1 ./cover_one 2>&1 | tee err.log
110+
if [ 0 == ${PIPESTATUS[0} ] ; then
111+
echo "expected to fail - but passed"
112+
exit 1
113+
fi
114+
grep "appears to be empty" err.log
115+
if [ 0 != $? ] ; then
116+
echo "expected error message not found"
117+
exit 1
118+
fi
119+
107120
cover cover_one -silent 1
108121
109122
$COVER ${EXEC_COVER} $PERL2LCOV_TOOL --output one.info --testname test1 ./cover_one
110123
if [ 0 != $? ] ; then
111124
echo "perl2lcov failed"
125+
exit 1
112126
fi
113127
114128
# did we generate the test name we expected
@@ -196,6 +210,27 @@ for l in `grep -E '^DA:' checksum.info` ; do
196210
done
197211
198212
213+
$COVER ${EXEC_COVER} $PERL2LCOV_TOOL -o x.info --exclude example.pl ./cover_one
214+
if [ 0 == $? ] ; then
215+
echo "expected ERROR_EMPTY not found"
216+
if [ 0 == $KEEP_GOING ] ; then
217+
exit 1
218+
fi
219+
fi
220+
$COVER ${EXEC_COVER} $PERL2LCOV_TOOL --exclude example.pl --ignore empty ./cover_one -o x.info
221+
if [ 0 != $? ] ; then
222+
echo "didn't ignore ERROR_EMPTY"
223+
if [ 0 == $KEEP_GOING ] ; then
224+
exit 1
225+
fi
226+
fi
227+
if [ `test ! -z x.info` ] ; then
228+
echo 'expected empty file - but not empty'
229+
if [ 0 == $KEEP_GOING ] ; then
230+
exit 1
231+
fi
232+
fi
233+
199234
$COVER ${EXEC_COVER} $PERL2LCOV_TOOL --help
200235
if [ 0 != $? ] ; then
201236
echo "perl2lcov help failed"

0 commit comments

Comments
 (0)