vg_perf.in revision 444e4b4b2884c3af83e7479775b57a8963a17788 
1#! @PERL@
2##--------------------------------------------------------------------##
3##--- Valgrind performance testing script                  vg_perf ---##
4##--------------------------------------------------------------------##
5
6#  This file is part of Valgrind, a dynamic binary instrumentation
7#  framework.
8#
9#  Copyright (C) 2005 Nicholas Nethercote
10#     njn@valgrind.org
11#
12#  This program is free software; you can redistribute it and/or
13#  modify it under the terms of the GNU General Public License as
14#  published by the Free Software Foundation; either version 2 of the
15#  License, or (at your option) any later version.
16#
17#  This program is distributed in the hope that it will be useful, but
18#  WITHOUT ANY WARRANTY; without even the implied warranty of
19#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20#  General Public License for more details.
21#
22#  You should have received a copy of the GNU General Public License
23#  along with this program; if not, write to the Free Software
24#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
25#  02111-1307, USA.
26#
27#  The GNU General Public License is contained in the file COPYING.
28
29#----------------------------------------------------------------------------
30# usage: see usage message.
31#
32# The easiest way is to run all tests in valgrind/ with (assuming you installed
33# in $PREFIX):
34#
35#   perl perf/vg_perf --all
36#
37# You can specify individual files to test, or whole directories, or both.
38# Directories are traversed recursively, except for ones named, for example, 
39# CVS/ or docs/.
40#
41# Each test is defined in a file <test>.vgperf, containing one or more of the
42# following lines, in any order:
43#   - prog:   <prog to run>                         (compulsory)
44#   - tools:  <Valgrind tools>                      (compulsory)
45#   - args:   <args for prog>                       (default: none)
46#   - vgopts: <Valgrind options>                    (default: none)
47#   - prereq: <prerequisite command>                (default: none)
48#   - cleanup: <post-test cleanup cmd to run>       (default: none)
49#
50# The prerequisite command, if present, must return 0 otherwise the test is
51# skipped.
52#----------------------------------------------------------------------------
53
54use warnings;
55use strict;
56
57#----------------------------------------------------------------------------
58# Global vars
59#----------------------------------------------------------------------------
60my $usage = <<END
61usage: vg_perf [options] [files or dirs]
62
63  options for the user, with defaults in [ ], are:
64    -h --help             show this message
65    --all                 run all tests under this directory
66    --reps                number of repeats for each program [3]
67    --vg                  Valgrind(s) to measure (can be specified multiple
68                            times).  The "in-place" build is used.
69                            [Valgrind in the current directory]
70END
71;
72
73# Test variables
74my $vgopts;             # valgrind options
75my $prog;               # test prog
76my $args;               # test prog args
77my $prereq;             # prerequisite test to satisfy before running test
78my $cleanup;            # cleanup command to run
79my @tools;              # which tools are we measuring the program with
80
81# Abbreviations used in output
82my %toolnames = ( 
83    none        => "nl",
84    memcheck    => "mc",
85    cachegrind  => "cg",
86    massif      => "ms"
87);
88
89# Command line options
90my $n_reps = 3;     # Run each program $n_reps times and choose the best one.
91my @vgdirs;         # Dirs of the various Valgrinds being measured.
92
93my $num_tests_done   = 0;
94my $num_timings_done = 0;
95
96# Starting directory
97chomp(my $tests_dir = `pwd`);
98
99#----------------------------------------------------------------------------
100# Process command line, setup
101#----------------------------------------------------------------------------
102
103# If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
104#
105# 1. Can prepend "." onto programs to avoid trouble with users who don't have
106#    "." in their path (by making $dir = ".")
107# 2. Can prepend the current dir to make the command absolute to avoid
108#    subsequent trouble when we change directories.
109#
110# Also checks the program exists and is executable.
111sub validate_program ($$$$) 
112{
113    my ($dir, $prog, $must_exist, $must_be_executable) = @_;
114
115    # If absolute path, leave it alone.  If relative, make it
116    # absolute -- by prepending current dir -- so we can change
117    # dirs and still use it.
118    $prog = "$dir/$prog" if ($prog !~ /^\//);
119    if ($must_exist) {
120        (-f $prog) or die "vg_perf: '$prog' not found or not a file ($dir)\n";
121    }
122    if ($must_be_executable) { 
123        (-x $prog) or die "vg_perf: '$prog' not executable ($dir)\n";
124    }
125
126    return $prog;
127}
128
129sub validate_tools($)
130{
131    # XXX: should check they exist!
132    my ($toolnames) = @_;
133    my @t = split(/\s+/, $toolnames);
134    return @t;
135}
136
137sub add_vgdir($)
138{
139    my ($vgdir) = @_;
140    if ($vgdir !~ /^\//) { $vgdir = "$tests_dir/$vgdir"; }
141    validate_program($vgdir, "./coregrind/valgrind", 1, 1);
142    push(@vgdirs, $vgdir);
143}
144
145sub process_command_line() 
146{
147    my $alldirs = 0;
148    my @fs;
149    
150    for my $arg (@ARGV) {
151        if ($arg =~ /^-/) {
152            if      ($arg =~ /^--all$/) {
153                $alldirs = 1;
154            } elsif ($arg =~ /^--reps=(\d+)$/) {
155                $n_reps = $1;
156                if ($n_reps < 1) { die "bad --reps value: $n_reps\n"; }
157            } elsif ($arg =~ /^--vg=(.+)$/) {
158                # Make dir absolute if not already
159                add_vgdir($1);
160            } else {
161                die $usage;
162            }
163        } else {
164            push(@fs, $arg);
165        }
166    }
167
168    # If no --vg options were specified, use the current tree.
169    if (0 == @vgdirs) {
170        add_vgdir($tests_dir);
171    }
172
173    if ($alldirs) {
174        @fs = ();
175        foreach my $f (glob "*") {
176            push(@fs, $f) if (-d $f);
177        }
178    }
179
180    (0 != @fs) or die "No test files or directories specified\n";
181
182    return @fs;
183}
184
185#----------------------------------------------------------------------------
186# Read a .vgperf file
187#----------------------------------------------------------------------------
188sub read_vgperf_file($)
189{
190    my ($f) = @_;
191
192    # Defaults.
193    ($vgopts, $prog, $args, $prereq, $cleanup)
194      = ("", undef, "", undef, undef, undef, undef);
195
196    open(INPUTFILE, "< $f") || die "File $f not openable\n";
197
198    while (my $line = <INPUTFILE>) {
199        if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
200	    next;
201	} elsif ($line =~ /^\s*vgopts:\s*(.*)$/) {
202            $vgopts = $1;
203        } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
204            $prog = validate_program(".", $1, 1, 1);
205        } elsif ($line =~ /^\s*tools:\s*(.*)$/) {
206            @tools = validate_tools($1);
207        } elsif ($line =~ /^\s*args:\s*(.*)$/) {
208            $args = $1;
209        } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
210            $prereq = $1;
211        } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
212            $cleanup = $1;
213        } else {
214            die "Bad line in $f: $line\n";
215        }
216    }
217    close(INPUTFILE);
218
219    if (!defined $prog) {
220        $prog = "";     # allow no prog for testing error and --help cases
221    }
222    if (0 == @tools) {
223        die "vg_perf: missing 'tools' line in $f\n";
224    }
225}
226
227#----------------------------------------------------------------------------
228# Do one test
229#----------------------------------------------------------------------------
230# Since most of the program time is spent in system() calls, need this to
231# propagate a Ctrl-C enabling us to quit.
232sub mysystem($) 
233{
234    my ($cmd) = @_;
235    my $retval = system($cmd);
236    if ($retval == 2) { 
237        exit 1; 
238    } else {
239        return $retval;
240    }
241}
242
243# Run program N times, return the best user time.
244sub time_prog($$)
245{
246    my ($cmd, $n) = @_;
247    my $tmin = 999999;
248    for (my $i = 0; $i < $n; $i++) {
249        mysystem("echo '$cmd' > perf.cmd");
250        my $retval = mysystem("$cmd > perf.stdout 2> perf.stderr");
251        (0 == $retval) or 
252            die "\n*** Command returned non-zero ($retval)"
253              . "\n*** See perf.{cmd,stdout,stderr} to determine what went wrong.\n";
254        my $out = `cat perf.stderr`;
255        ($out =~ /usertime: ([\d\.]+)s/) or 
256            die "\n*** missing usertime in perf.stderr\n";
257        $tmin = $1 if ($1 < $tmin);
258    }
259    # Avoid divisions by zero!
260    return (0 == $tmin ? 0.01 : $tmin);
261}
262
263sub do_one_test($$) 
264{
265    my ($dir, $vgperf) = @_;
266    $vgperf =~ /^(.*)\.vgperf/;
267    my $name = $1;
268    my %first_tTool;    # For doing percentage speedups when comparing
269                        # multiple Valgrinds
270
271    read_vgperf_file($vgperf);
272
273    if (defined $prereq) {
274        if (system("$prereq") != 0) {
275            printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
276            return;
277        }
278    }
279
280    my $timecmd = "/usr/bin/time -f 'usertime: %Us'";
281
282    # Do the native run(s).
283    printf("-- $name --\n") if (@vgdirs > 1);
284    my $cmd     = "$timecmd $prog $args";
285    my $tNative = time_prog($cmd, $n_reps);
286
287    foreach my $vgdir (@vgdirs) {
288        # Benchmark name
289        printf("%-8s ", $name);
290
291        # Print the Valgrind version if we are measuring more than one.
292        my $vgdirname = $vgdir;
293        chomp($vgdirname = `basename $vgdir`);
294        printf("%-10s:", $vgdirname);
295        
296        # Native execution time
297        printf("%4.1fs  ", $tNative);
298
299        foreach my $tool (@tools) {
300            (defined $toolnames{$tool}) or 
301                die "unknown tool $tool, please add to %toolnames\n";
302
303            # Do the tool run(s).  Set both VALGRIND_LIB and VALGRIND_LIB_INNER
304            # in case this Valgrind was configured with --enable-inner.
305            printf("%s:", $toolnames{$tool});
306            my $vgsetup = "VALGRIND_LIB=$vgdir/.in_place "
307                        . "VALGRIND_LIB_INNER=$vgdir/.in_place ";
308            my $vgcmd   = "$vgdir/coregrind/valgrind "
309                        . "--command-line-only=yes --tool=$tool -q "
310                        . "--memcheck:leak-check=no --addrcheck:leak-check=no "
311                        . "$vgopts ";
312            my $cmd     = "$vgsetup $timecmd $vgcmd $prog $args";
313            my $tTool   = time_prog($cmd, $n_reps);
314            printf("%4.1fs (%4.1fx,", $tTool, $tTool/$tNative);
315
316            # If it's the first timing for this tool on this benchmark,
317            # record the time so we can get the percentage speedup of the
318            # subsequent Valgrinds.  Otherwise, compute and print
319            # the speedup.
320            if (not defined $first_tTool{$tool}) {
321                $first_tTool{$tool} = $tTool;
322                print(" -----)  ");
323            } else {
324                my $speedup = 100 - (100 * $tTool / $first_tTool{$tool});
325                printf("%5.1f%%)  ", $speedup);
326            }
327
328            $num_timings_done++;
329
330            if (defined $cleanup) {
331                (system("$cleanup") == 0) or 
332                    print("  ($name cleanup operation failed: $cleanup)\n");
333            }
334        }
335        printf("\n");
336    }
337
338    $num_tests_done++;
339}
340
341#----------------------------------------------------------------------------
342# Test one directory (and any subdirs)
343#----------------------------------------------------------------------------
344sub test_one_dir($$);    # forward declaration
345
346sub test_one_dir($$) 
347{
348    my ($dir, $prev_dirs) = @_;
349    $dir =~ s/\/$//;    # trim a trailing '/'
350
351    # Ignore dirs into which we should not recurse.
352    if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
353
354    chdir($dir) or die "Could not change into $dir\n";
355
356    # Nb: Don't prepend a '/' to the base directory
357    my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
358    my $dashes = "-" x (50 - length $full_dir);
359
360    my @fs = glob "*";
361    my $found_tests = (0 != (grep { $_ =~ /\.vgperf$/ } @fs));
362
363    if ($found_tests) {
364        print "-- Running  tests in $full_dir $dashes\n";
365    }
366    foreach my $f (@fs) {
367        if (-d $f) {
368            test_one_dir($f, $full_dir);
369        } elsif ($f =~ /\.vgperf$/) {
370            do_one_test($full_dir, $f);
371        }
372    }
373    if ($found_tests) {
374        print "-- Finished tests in $full_dir $dashes\n";
375    }
376
377    chdir("..");
378}
379
380#----------------------------------------------------------------------------
381# Summarise results
382#----------------------------------------------------------------------------
383sub summarise_results 
384{
385    printf("\n== %d programs, %d timings =================\n\n", 
386           $num_tests_done, $num_timings_done);
387}
388
389#----------------------------------------------------------------------------
390# main()
391#----------------------------------------------------------------------------
392
393# nuke VALGRIND_OPTS
394$ENV{"VALGRIND_OPTS"} = "";
395
396my @fs = process_command_line();
397foreach my $f (@fs) {
398    if (-d $f) {
399        test_one_dir($f, "");
400    } else { 
401        # Allow the .vgperf suffix to be given or omitted
402        if ($f =~ /.vgperf$/ && -r $f) {
403            # do nothing
404        } elsif (-r "$f.vgperf") {
405            $f = "$f.vgperf";
406        } else {
407            die "`$f' neither a directory nor a readable test file/name\n"
408        }
409        my $dir  = `dirname  $f`;   chomp $dir;
410        my $file = `basename $f`;   chomp $file;
411        chdir($dir) or die "Could not change into $dir\n";
412        do_one_test($dir, $file);
413        chdir($tests_dir);
414    }
415}
416summarise_results();
417
418##--------------------------------------------------------------------##
419##--- end                                                          ---##
420##--------------------------------------------------------------------##
421