cvsuser 04/08/09 08:09:36
Modified: tools/dev parrot_coverage.pl
Log:
This patch addresses multiple problems with tools/dev/parrot_coverage.pl
that were encountered with a parrot-cvs built on Monday, August 9, 2004.
Courtesy of <[EMAIL PROTECTED]>
Revision Changes Path
1.3 +30 -18 parrot/tools/dev/parrot_coverage.pl
Index: parrot_coverage.pl
===================================================================
RCS file: /cvs/public/parrot/tools/dev/parrot_coverage.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- parrot_coverage.pl 20 Jan 2004 19:01:43 -0000 1.2
+++ parrot_coverage.pl 9 Aug 2004 15:09:36 -0000 1.3
@@ -1,7 +1,7 @@
#! perl -w
################################################################################
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: parrot_coverage.pl,v 1.2 2004/01/20 19:01:43 mikescott Exp $
+# $Id: parrot_coverage.pl,v 1.3 2004/08/09 15:09:36 dan Exp $
################################################################################
=head1 NAME
@@ -47,7 +47,7 @@
system("make");
#### Now run the tests
- system("make test");
+ system("make fulltest");
}
#### And generate the reports.
@@ -71,22 +71,33 @@
foreach my $da_file (@dafiles) {
my $dirname = dirname($da_file) || ".";
my $filename = basename($da_file);
+ my $objectfilename = $da_file;
+ $objectfilename =~ s/\.da$//g;
- my $cmd = "cd $dirname; gcov -f -b $filename";
+ #gcov must be run from the directory that the compiler was invoked from.
+ #Currently, this is the parrot root directory.
+ #However, it also leaves it output file in this directory, which we need
+ #to move to the appropriate place, alongside the sourcefile that produced it.
+ #Hence, as soon as we know the true name of the object file being profiled,
+ #we rename the gcov log file.
+ #The -o flag is necessary to help gcov locate it's basic block (.bb) files.
+ my $cmd = "gcov -f -b -o $da_file $objectfilename";
print "Running $cmd..\n" if $DEBUG;
open (GCOVSUMMARY, "$cmd|") || die "Error invoking '$cmd': $!";
my $tmp;
my %generated_files;
while (<GCOVSUMMARY>) {
if (/^Creating (.*)\./) {
- my $path = "$dirname/$1"; $path =~ s/\Q$SRCDIR\E//g;
+ my $path = "$dirname/$1";
+ rename($1, "$dirname/$1") || die("Couldn't rename $1 to $dirname/$1.");
+ $path =~ s/\Q$SRCDIR\E//g;
$generated_files{$path} = $tmp;
$tmp = '';
} else {
$tmp .= $_;
}
}
- close(GCOVSUMARY);
+ close(GCOVSUMMARY);
foreach my $gcov_file (keys %generated_files) {
my $source_file = $gcov_file;
@@ -101,7 +112,7 @@
print "Processing $gcov_file ($source_file)\n";
foreach (split "\n", $generated_files{$gcov_file}) {
- my ($percent, $total_lines, $real_filename) = /\s*([^%]+)% of (\d+)
source lines executed in file (.*)/;
+ my ($percent, $total_lines, $real_filename) = /\s*([^%]+)% of (\d+)(?:
source)? lines executed in file (.*)/;
if ($total_lines) {
my $covered_lines = int(($percent/100) * $total_lines);
$totals{lines} += $total_lines;
@@ -111,7 +122,7 @@
next;
}
- my ($percent, $total_lines, $function) = /\s*([^%]+)% of (\d+) source
lines executed in function (.*)/;
+ my ($percent, $total_lines, $function) = /\s*([^%]+)% of (\d+)(?:
source)? lines executed in function (.*)/;
if ($total_lines) {
$function_line_coverage{$source_file}{$function} = $percent;
next;
@@ -210,6 +221,7 @@
<th>Line Coverage</th>
<th>Branch Coverage</th>
<th>Call Coverage</th>
+ </tr>
);
foreach my $source_file (sort keys %file_line_coverage) {
@@ -366,7 +378,7 @@
next if (&{$skip_func}($_));
- my $atag;
+ my $atag="";
if (/^\s*([^\(\s]+)\(/) {
$atag="<a name=\"$1\"></a>";
}
@@ -385,7 +397,7 @@
} elsif ($initial =~ /\#\#\#/) {
print OUT qq($atag<font color="red">$_</font>)
} else {
- print OUT "$atag$_";
+ print OUT $_;
}
}
}
