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