1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
#!/usr/bin/perl -w
# script to see if new test files increase code coverage.
# compile code with gcc options -fprofile-arcs -ftest-coverage.
# place baseline and candidate test in the relative subdirectories oldtests
# and newtests repectively.
# run this script.
use FILE::Find;
use strict;
# old and new test file locations (relative, recursive, can be sym
# links).
my $baseline_tests='oldtests';
my $testcase_candidates='newtests';
# subdir of all covered files (recursive)
my $cfiles="../../";
# hash - key is c file covered, value percent coverage.
my %baseline_coverage=();
my %new_tests_plus_baseline_coverage=();
# file to hold %baseline_coverage.
my $base="baseline.txt";
# commands to run on test files.
my @args= ( ["./pcl6", "-n", "-sDEVICE=ppmraw", "-sOutputFile=/dev/null", "-r300", "-dNOPAUSE" ],
["./pcl6", "-n", "-sDEVICE=pbmraw", "-sOutputFile=/dev/null", "-r300", "-dNOPAUSE" ], );
# parse gcov output
sub get_coverage_for_a_source_file {
my $test = shift(@_);
my $source_file; my $percent;
open (PIPE, "gcov $test 2>&1|") || die "gcov pipe failed $!";
while (<PIPE>) {
if (/^File \'(.*)\'/) { $source_file = $1; }
if (/^Lines executed:(\d+\.\d+)\%/) { $percent = $1; }
}
return ($source_file, $percent);
}
sub clear_coverage {
# yikes
unlink glob("*.gcov");
unlink glob("*.gcda");
}
sub print_coverage_increase {
my $test_file = shift(@_);
my $total = 0;
while (my($f, $p) = each(%baseline_coverage)) {
exists $new_tests_plus_baseline_coverage{$f} ||
die "internal error: regenerate baseline with recompiled code\n";
my $np = $new_tests_plus_baseline_coverage{$f};
if ( $np > $p ) {
print "test file: $test_file caused coverage increase for $f increased from $p to $np\n";
$total++;
}
}
print "test file: $test_file changed coverage for $total files\n";
}
sub proc_new_coverage {
if (/^.*\.c\z/s) {
my $cf = $File::Find::name;
print "$cf\r";
my($f, $p) = get_coverage_for_a_source_file $cf;
$new_tests_plus_baseline_coverage{$f} = $p if (defined($f) && defined($p));
}
}
sub proc_run_tests {
if (-f $_) {
my $f = $File::Find::name;
map(print("@$_ $f\n"), @args);
map(system(@$_, $f), @args);
}
}
sub proc_run_new_tests {
if (-f $_) {
my $f = $File::Find::name;
clear_coverage;
map(print("@$_ $f\n"), @args);
map(system(@$_, $f), @args);
File::Find::find({ wanted => \&proc_new_coverage, no_chdir => 1 }, $cfiles);
print_coverage_increase $f;
}
}
sub proc_baseline_coverage {
if (/^.*\.c\z/s) {
print "$File::Find::name\r";
my($s, $p) = get_coverage_for_a_source_file $File::Find::name;
print(BASE "$s $p\n") if (defined($s) && defined($p));
}
}
sub build_baseline {
open(BASE, ">>$base");
File::Find::find({ wanted => \&proc_run_tests, no_chdir => 1 }, $baseline_tests);
File::Find::find({ wanted => \&proc_baseline_coverage, no_chdir => 1 }, $cfiles);
close(BASE);
}
sub do_new_tests {
File::Find::find({ wanted => \&proc_run_new_tests, no_chdir => 1 }, $testcase_candidates);
}
build_baseline unless (-e $base);
open(BASE, $base) || die "open (BASELINE, $base)";
# read the baseline
%baseline_coverage=();
while (<BASE>) {
chomp;
my ($source_file, $percent) = split(/ /);
$baseline_coverage{$source_file} = $percent;
}
close(BASE);
do_new_tests;
|
