@@ -79,11 +79,11 @@ For example:
7979
8080 # write Perl line, branch, condition, and subroutine coverage data to
8181 # 'myPerlDB' in the current directory
82- \$ perl -MDevel::Cover=-db,./myPerlDB,-coverage,statement,branch,condition,subroutine,-silent,1 myScript.pl
82+ \$ perl -MDevel::Cover=-db,.\ /
8383 # OR: write all the coverage types that Perl knows about to 'myPerlDB2' -
84- # note that perl2lcov will ignore types it does not understand/does not use
85- # (pod, time, and path)
86- \$ perl -MDevel::Cover=-db,./myPerlDB2,-silent,1 myScript.pl
84+ # note that perl2lcov will ignore types it does not understand/does
85+ # not use (pod, time, and path)
86+ \$ perl -MDevel::Cover=-db,.\ /
8787 # run 'cover' from the Devel::Cover installation - to extract runtime
8888 # data into a usable form. This will also generate an HTML report
8989 # in 'myCoverDB'
@@ -93,6 +93,28 @@ For example:
9393 # and generate a genhtml-format coverage report:
9494 \$ genhtml -o html_report perldata.info ...
9595
96+ Note that the data generateed by Devel::Cover is not always internally
97+ consistent. For example:
98+
99+ - some which are never called, do not appear in the coverage data.
100+
101+ - sometimes, a line will appear to be executed (non-zero hit count) but
102+ none of its contained branch expressions have been evaluated.
103+ (If the line was executed, then at least one branch condition must have
104+ been evaluated.
105+
106+ This can cause the various tools in the lcov package to generate errors of
107+ type 'inconsistent'.
108+ In that case, you can:
109+
110+ - skip consistency checks entirely: see the 'skip_consistency_checks' section
111+ in man lovrc(5)
112+
113+ - ignore the error: see the '--ignore-error' section in man genhtml(1)
114+
115+ - exclude the offending code: see the '--exclude', '--filter', and
116+ '--omit-lines' sections in man genhtml(1).
117+
96118END_OF_USAGE
97119}
98120
@@ -110,7 +132,7 @@ sub findPackage
110132 if ($line < $v -> [0]) {
111133 $max = $mid - 1;
112134 } elsif ($line > $v -> [0]) {
113- $best = $v -> [1] ;
135+ $best = $v ;
114136 $min = $mid + 1;
115137 } else {
116138 # line number matched...which ought not to happen because
@@ -119,7 +141,7 @@ sub findPackage
119141 # That won't be the line containing "package ..." - unless the
120142 # user wrote the whole thing on one line. Not clever. Deserves
121143 # to lose, if something in here breaks.
122- return $v -> [1] ;
144+ return $v ;
123145 }
124146 }
125147 return $best ;
@@ -175,6 +197,9 @@ foreach my $db (@ARGV) {
175197 # use statement coverage to mark un-evaluated branches
176198 my ($stmts , $branches , $conditions , $subroutines );
177199 my @packageExtents ;
200+ # Devel::Cover doesn't instrument all the functions in every file -
201+ # so need a workaround to find better extents for some of them
202+ my @functionExtents ;
178203
179204 foreach my $criteria ($f -> items) {
180205 # some types we don't use
@@ -188,11 +213,13 @@ foreach my $db (@ARGV) {
188213 $subroutines = $c ;
189214 if (-f $file ) {
190215 open (GREP, ' -|' ' grep' ' --line-number' ' -E'
191- ' ^\s*package ' $file ) or
216+ ' ^\s*( package|sub) ' $file ) or
192217 die (" unable to grep $file : $! "
193218 while (<GREP>) {
194- if (/ ^(\d +):\s *package\s +(\S +?) ;/
219+ if (/ ^(\d +):\s *package\s +(\S +) \s * ;/
195220 push (@packageExtents , [$1 , $2 . ' ::'
221+ } elsif (/ ^(\d +):\s *sub\s +([^\s (]+)/
222+ push (@functionExtents , [$1 , $2 ]);
196223 } else {
197224 die (" unexpected grep output '$_ '"
198225 }
@@ -248,7 +275,7 @@ foreach my $db (@ARGV) {
248275 if ($name !~ / (BEGIN|__ANON__)/
249276 my $p = findPackage(\@packageExtents , $line );
250277 if (defined ($p )) {
251- $name = $p . $name ;
278+ $name = $p -> [1] . $name ;
252279 }
253280 $functionMap -> define_function($name , $line );
254281 $functionMap -> add_count($name , $count );
@@ -347,6 +374,58 @@ foreach my $db (@ARGV) {
347374 $fileData -> sum()-> union($lineMap );
348375 $fileData -> sumbr()-> union($branchMap );
349376 $fileData -> func()-> union($functionMap );
377+
378+ # have to do this manually due to some Perl quirks -
379+ # in particular, there may be code outside of the subroutine we are
380+ # walking...and we want to correct the end line
381+ TraceFile::_deriveFunctionEndLines($fileData );
382+ my $lineData = $fileData -> sum();
383+ my $funcData = $fileData -> testfnc();
384+
385+ foreach my $func ($fileData -> func()-> valuelist()) {
386+ # where is the nearest 'package' after my start line?
387+ my $first = $func -> line();
388+ my $end = $func -> end_line();
389+ next unless defined ($end );
390+ # find package or function enclosing my end line..
391+ my $last = $end ;
392+ foreach my $ext (\@packageExtents , \@functionExtents ) {
393+ while (1) {
394+ my $p = findPackage($ext , $last );
395+ if (defined ($p ) && $p -> [0] > $first ) {
396+ $last = $p -> [0] - 1;
397+ lcovutil::info(1,
398+ $func -> name() .
399+ " : found update end line $last in "
400+ $p -> [1] . " \n "
401+ # iterate in case there is another package above the first one
402+ } else {
403+ last ;
404+ }
405+ }
406+ }
407+ next unless $last < $end ;
408+
409+ # what is the last executable line before the 'package' or 'sub' decl?
410+ while ($last > $first ) {
411+ if (defined ($lineData -> value($last ))) {
412+ last ;
413+ }
414+ --$last ;
415+ }
416+ lcovutil::info(1,
417+ " resetting " $func -> name() .
418+ " end line to $last (from $end )\n "
419+ $func -> set_end_line($last );
420+
421+ foreach my $tn ($funcData -> keylist()) {
422+ my $d = $funcData -> value($tn );
423+ my $f = $d -> findKey($first );
424+ $f -> set_end_line($last );
425+ }
426+
427+ } # foreach function
428+
350429 } # foreach file
351430} # foreach cover db
352431
0 commit comments