Commit | Line | Data |
---|---|---|
17ba0788 C |
1 | # Copyright 2012, INRIA |
2 | # Julia Lawall, Gilles Muller | |
3 | # Copyright 2010-2011, INRIA, University of Copenhagen | |
f537ebc4 C |
4 | # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
5 | # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
6 | # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
7 | # This file is part of Coccinelle. | |
8 | # | |
9 | # Coccinelle is free software: you can redistribute it and/or modify | |
10 | # it under the terms of the GNU General Public License as published by | |
11 | # the Free Software Foundation, according to version 2 of the License. | |
12 | # | |
13 | # Coccinelle is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | # GNU General Public License for more details. | |
17 | # | |
18 | # You should have received a copy of the GNU General Public License | |
19 | # along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
20 | # | |
21 | # The authors reserve the right to distribute this or future versions of | |
22 | # Coccinelle under other licenses. | |
23 | ||
24 | ||
34e49164 C |
25 | #!/usr/bin/perl |
26 | ||
27 | use strict; | |
28 | use diagnostics; | |
29 | ||
30 | #use Data::Dumper; | |
31 | #use Date::Manip qw(ParseDate UnixDate); #sudo apt-get install libdate-manip-perl | |
32 | #use Date::Calc qw(Delta_Days); #sudo apt-get install libdate-calc-perl | |
33 | ||
34 | #------------------------------------------------------------------------------ | |
35 | # Helpers | |
36 | #------------------------------------------------------------------------------ | |
37 | ||
38 | my $debug = 0; | |
39 | ||
40 | sub pr2 { print STDERR "@_\n"; } | |
41 | sub pr { print "@_\n"; } | |
42 | sub mylog { print STDERR "@_\n" if $debug; } | |
43 | ||
44 | sub plural { | |
45 | my ($n) = @_; | |
46 | $n > 1 ? "s" : ""; | |
47 | } | |
48 | ||
49 | #------------------------------------------------------------------------------ | |
50 | # Globals | |
51 | #------------------------------------------------------------------------------ | |
52 | ||
53 | my $ok = 0; | |
54 | my $so = 0; #spatch ok | |
55 | my $fa = 0; #failed | |
56 | my $gu = 0; #gave up | |
57 | ||
58 | my $nbfiles = 0; | |
59 | ||
60 | my $maxtime = 0; | |
61 | #my $mintime = 0; | |
62 | my $sumtime = 0; | |
63 | ||
64 | my $sumlinefiles = 0; | |
65 | ||
66 | my $errors = 0; | |
67 | ||
68 | my $sumlineP = 0; #whole git | |
69 | my $sumlineP2 = 0; | |
70 | my $sumlinePchange = 0; | |
71 | ||
72 | my $spfile = ""; | |
73 | my $ruleno = "??"; | |
74 | my $sizeSP = 0; | |
75 | ||
76 | my $cedescr = ""; | |
77 | ||
78 | my $numauthors = 0; | |
79 | my $duration = 0; # in days | |
80 | ||
81 | my @cfiles = (); | |
82 | ||
83 | #------------------------------------------------------------------------------ | |
84 | # SP | |
85 | #------------------------------------------------------------------------------ | |
86 | $spfile = `make sp_file`; | |
87 | chomp $spfile; | |
88 | ||
89 | if($spfile =~ /(rule|mega|bt)(\d+)\.cocci/) { $ruleno = "$2"; } | |
90 | ||
91 | #------------------------------------------------------------------------------ | |
92 | # CE | |
93 | #------------------------------------------------------------------------------ | |
94 | ||
95 | #$cedescr = `make ce_descr`; | |
96 | #chomp $cedescr; | |
97 | #print STDERR (Dumper($cedescr)); | |
98 | open TMP, "Makefile" or die "no Makefile file ?"; | |
99 | while(<TMP>) { | |
100 | if(/^(CE)?DESCRIPTION=["'](.*)["']/) { $cedescr = $2; } | |
101 | } | |
102 | ||
103 | ||
104 | ||
105 | #$cedescr =~ s/\\/\\\\/g; | |
106 | #$cedescr =~ s/\f/\\f/g; | |
107 | #$cedescr =~ s/\t/\\t/g; | |
108 | ||
109 | #------------------------------------------------------------------------------ | |
110 | # List c files | |
111 | #------------------------------------------------------------------------------ | |
112 | my $files = `make source_files`; | |
113 | chomp $files; | |
114 | @cfiles = split /\s+/, $files; | |
115 | ||
116 | $nbfiles = scalar(@cfiles); | |
117 | ||
118 | #------------------------------------------------------------------------------ | |
119 | # Size files (lines) | |
120 | #------------------------------------------------------------------------------ | |
121 | map { | |
122 | my ($linefile) = `wc -l $_`; | |
123 | chomp $linefile; | |
124 | die "wierd wc output" unless $linefile =~ /^(\d+) /; | |
125 | $sumlinefiles += $1; | |
126 | mylog "filesize $_ $1"; | |
127 | } @cfiles; | |
128 | ||
129 | ||
130 | #------------------------------------------------------------------------------ | |
131 | # Size SP | |
132 | #------------------------------------------------------------------------------ | |
133 | $sizeSP = | |
134 | `cat $spfile | perl -p -e "s/\\/\\/.*//g;" | grep -v '^[ \t]*\$' | wc -l`; | |
135 | chomp $sizeSP; | |
136 | ||
137 | ||
138 | #------------------------------------------------------------------------------ | |
139 | # Bugs | |
140 | #------------------------------------------------------------------------------ | |
141 | if(!(-e "README")) { pr2 "no README file ?"; } | |
142 | else { | |
143 | open TMP, "README" or die "no README file ?"; | |
144 | while(<TMP>) { | |
145 | if (/\[bug\]/ || /status\]\s*bug/ || /status\]\s*BUG/ ) { | |
146 | ||
147 | # can also look for [semibug] but it's often related to [corrected_c] kind of pbs | |
148 | #|| /status\]\s*semi-bug/ | |
149 | ||
150 | #pr2 "OLD BUG FORMAT: $_"; | |
151 | $errors++ | |
152 | } | |
153 | } | |
154 | } | |
155 | ||
156 | ||
157 | ||
158 | #------------------------------------------------------------------------------ | |
159 | # Size P (total) | |
160 | #------------------------------------------------------------------------------ | |
161 | ||
162 | if(-e "gitinfo") { | |
163 | ($sumlineP) = `cat gitinfo |wc -l`; | |
164 | chomp $sumlineP; | |
165 | } else { | |
166 | pr2 "no GIT INFO?"; | |
167 | } | |
168 | ||
169 | #------------------------------------------------------------------------------ | |
170 | # Number of authors and duration | |
171 | #------------------------------------------------------------------------------ | |
172 | ||
173 | ||
174 | if(-e "gitinfo") { | |
175 | ||
176 | open TMP, "gitinfo" or die "no gitinfo file ?"; | |
177 | ||
178 | #for authors | |
179 | my $h = {}; | |
180 | ||
181 | #for duration | |
182 | my @mindate = (); | |
183 | my @maxdate = (); | |
184 | my $nodateyet = 1; | |
185 | ||
186 | while(<TMP>) { | |
187 | #can also do: egrep "^Author" gitinfo | sort | uniq | wc -l | |
188 | if (/^Author: (.*)/) { | |
189 | $h->{$1}++; | |
190 | } | |
191 | ||
192 | # if(/^Date: (.*) ([-+]\d+)?/) { | |
193 | # my $date = ParseDate($1); | |
194 | # if (!$date) { die "bad date" } | |
195 | # else { | |
196 | # my ($year, $month, $day) = UnixDate($date, "%Y", "%m", "%d"); | |
197 | # my @current = ($year, $month, $day); | |
198 | # if($nodateyet) { | |
199 | # @mindate = @current; | |
200 | # @maxdate = @current; | |
201 | # $nodateyet = 0; | |
202 | # } else { | |
203 | # my $diff1 = Delta_Days(@mindate, @current); | |
204 | # if($diff1 < 0) { @mindate = @current; } | |
205 | # my $diff2 = Delta_Days(@current, @maxdate); | |
206 | # if($diff2 < 0) { @maxdate = @current; } | |
207 | # | |
208 | # #pr2 "$diff1, $diff2"; | |
209 | # } | |
210 | # } | |
211 | # } | |
212 | ||
213 | ||
214 | ||
215 | } | |
216 | ||
217 | # my $diff = Delta_Days(@mindate, @maxdate); | |
218 | # if($diff == 1 || $diff == 0) { | |
219 | # $duration = "1 day"; | |
220 | # } | |
221 | # elsif($diff < 31) { | |
222 | # $duration = "$diff days"; | |
223 | # } | |
224 | # elsif($diff > 365) { | |
225 | # my $years = int($diff / 365); | |
226 | # my $s = plural($years); | |
227 | # $duration = "$years year$s"; | |
228 | # } | |
229 | # elsif($diff > 31) { | |
230 | # my $months = int($diff / 31); | |
231 | # my $s = plural($months); | |
232 | # $duration = "$months month$s"; | |
233 | # } | |
234 | # else { die "impossible"; } | |
235 | ||
236 | $duration = "xxx months"; | |
237 | ||
238 | $numauthors = scalar(keys %{$h}); | |
239 | } else { | |
240 | pr2 "no GIT INFO?"; | |
241 | } | |
242 | ||
243 | ||
244 | #------------------------------------------------------------------------------ | |
245 | # Size P (only change for .c in drivers/ or sounds/ (the test files)) | |
246 | #------------------------------------------------------------------------------ | |
247 | ||
248 | ||
249 | foreach my $c (@cfiles) { | |
250 | die "wierd: $c, with $spfile" unless ($c =~ /(.*)\.c$/); | |
251 | my $base = $1; | |
252 | my $bef = "$base.c"; | |
253 | my $aft = "$base.res"; | |
254 | if(-e "corrected_$base.res") { | |
255 | $aft = "corrected_$base.res"; | |
256 | mylog "found corrected"; | |
257 | } | |
258 | my $onlychange = 0; | |
259 | open TMP, "diff -u -b -B $bef $aft |"; | |
260 | ||
261 | my $count = 0; | |
262 | while(<TMP>) { | |
263 | $count++; | |
264 | ||
265 | if (/^\+[^+]/) { $onlychange++; } | |
266 | if (/^\-[^-]/) { $onlychange++; } | |
267 | } | |
268 | $sumlinePchange += $onlychange; | |
269 | $sumlineP2 += $count; | |
270 | } | |
271 | ||
272 | #------------------------------------------------------------------------------ | |
273 | # Time | |
274 | #------------------------------------------------------------------------------ | |
275 | foreach my $c (@cfiles) { | |
276 | die "" unless ($c =~ /(.*)\.c$/); | |
277 | my $base = $1; | |
278 | ||
279 | my $diagnosefile = ""; | |
280 | mylog "$base"; | |
281 | ||
282 | if(-e "$base.c.ok") { $ok++; $diagnosefile = "$base.c.ok"; } | |
283 | if(-e "$base.c.failed") { $fa++; $diagnosefile = "$base.c.failed"; } | |
284 | if(-e "$base.c.spatch_ok") { $so++; $diagnosefile = "$base.c.spatch_ok"; } | |
285 | if(-e "$base.c.gave_up") { $gu++; $diagnosefile = "$base.c.gave_up"; } | |
286 | ||
287 | open TMP, $diagnosefile or die "no diagnose $base: $diagnosefile"; | |
288 | my $found = 0; | |
289 | my $time = 0; | |
290 | while(<TMP>) { | |
291 | # before -test_okfailed | |
292 | # if (/real[ \t]+([0-9])+m([0-9]+)[.]([0-9]+)/) { | |
293 | # $found++; | |
294 | # | |
295 | # $time = $1 * 60.0; # minutes | |
296 | # $time += $2; # seconds | |
297 | # $time += $3 / 1000.0; # 1/1000th sec. | |
298 | # | |
299 | # pr2 (sprintf "%4.1fs\n", $time); | |
300 | # printf "I: %15s & %4.1fs\n", $c, $time; | |
301 | # | |
302 | # } | |
303 | if (/time: (.*)/) { | |
304 | $found++; | |
305 | ||
306 | $time = $1; | |
307 | ||
308 | mylog (sprintf "%4.1fs\n", $time); | |
309 | printf "I: %15s & %4.1fs\n", $c, $time; | |
310 | ||
311 | } | |
312 | ||
313 | ||
314 | } | |
315 | die "not found time information in $diagnosefile" unless $found == 1; | |
316 | ||
317 | $sumtime += $time; | |
318 | $maxtime = $time if $time > $maxtime; | |
319 | ||
320 | } | |
321 | ||
322 | #------------------------------------------------------------------------------ | |
323 | # Computations | |
324 | #------------------------------------------------------------------------------ | |
325 | ||
326 | my $correct = $ok + $so; | |
327 | ||
328 | my $pourcentcorrect = ($correct * 100.0) / $nbfiles; | |
329 | my $avglines = $sumlinefiles / $nbfiles; | |
330 | my $avgtime = $sumtime / $nbfiles; | |
331 | ||
332 | ||
333 | my $ratioPvsSP = $sumlineP / $sizeSP; | |
334 | my $ratioPvsSP2 = $sumlineP2 / $sizeSP; | |
335 | ||
336 | ||
337 | #------------------------------------------------------------------------------ | |
338 | # Results | |
339 | #------------------------------------------------------------------------------ | |
340 | ||
341 | ||
342 | pr "SP = $spfile"; | |
343 | mylog "FILES = \n"; | |
344 | map { mylog "\t$_"; } @cfiles; | |
345 | pr "----------------------------------------"; | |
346 | ||
347 | ||
348 | pr "!!Total files = $nbfiles"; | |
349 | printf "!!AvgLine = %.1fl\n", $avglines; | |
350 | ||
351 | #pr " Correct number = $correct"; | |
352 | printf "!!Correct = %.1f%s\n", $pourcentcorrect, "%"; | |
353 | ||
354 | pr "!!Human errors = $errors"; | |
355 | ||
356 | pr "!!Size SP = $sizeSP"; | |
357 | pr "!!Size P = $sumlineP"; | |
358 | pr "!!Size P (change only) = $sumlinePchange"; | |
359 | ||
360 | printf "!!Ratio P/SP = %3.1f\n", $ratioPvsSP; | |
361 | ||
362 | ||
363 | printf "!!RunTime = %.1fs\n", $sumtime; | |
364 | printf "!!MaxTime = %.1fs\n", $maxtime; | |
365 | printf "!!AvgTime = %.1fs\n", $avgtime; | |
366 | ||
367 | my $totalstatus = $ok + $fa + $so + $gu; | |
368 | mylog "----------------------------------------------------------------"; | |
369 | mylog "Sanity checks: nb files vs total status: $nbfiles =? $totalstatus"; | |
370 | ||
371 | ||
372 | ||
373 | printf "L: %20s (r%3s) & %5.1f%% & %5dfi & %2de & %6.1fx & %6.1fs \n", | |
374 | $cedescr, $ruleno, $pourcentcorrect, $nbfiles, $errors, $ratioPvsSP, $sumtime; | |
375 | ||
376 | ||
377 | # Mega, Complex, Bluetooth | |
378 | ||
379 | printf "M: %60s & %5d & %6d (%d) & %2d & %s & %2d & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", | |
380 | $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $numauthors, $duration, $errors, $sizeSP, $ratioPvsSP, | |
381 | $avgtime, $maxtime, $pourcentcorrect, $spfile; | |
382 | ||
383 | printf "C: %60s & %5d & %6d (%d) & %2d & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", | |
384 | $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $errors, $sizeSP, $ratioPvsSP, | |
385 | $avgtime, $maxtime, $pourcentcorrect, $spfile; | |
386 | ||
387 | printf "B: %60s & %5d & %5d (%d) & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", | |
388 | $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $sizeSP, $ratioPvsSP, | |
389 | $avgtime, $maxtime, $pourcentcorrect, $spfile; | |
390 | ||
391 |