1#! /usr/bin/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-2017 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# Sometimes it is useful to run all the tests at a high sanity check
47# level or with arbitrary other flags.  To make this simple, extra
48# options, applied to all tests run, are read from $EXTRA_REGTEST_OPTS,
49# and handed to valgrind prior to any other flags specified by the
50# .vgperf file. Note: the env var is the same as vg_regtest.
51#----------------------------------------------------------------------------
52
53use warnings;
54use strict;
55
56#----------------------------------------------------------------------------
57# Global vars
58#----------------------------------------------------------------------------
59my $usage = <<END
60usage: vg_perf [options] [files or dirs]
61
62  options for the user, with defaults in [ ], are:
63    -h --help             show this message
64    --reps=<n>            number of repeats for each program [1]
65    --tools=<t1,t2,t3>    tools to run [Nulgrind and Memcheck]
66    --vg=<dir>            top-level directory containing Valgrind to measure
67                          [Valgrind in the current directory, i.e. --vg=.]
68                          Can be specified multiple times.
69                          The "in-place" build is used.
70
71    --outer-valgrind: run these Valgrind(s) under the given outer valgrind.
72      These Valgrind(s) must be configured with --enable-inner.
73    --outer-tool: tool to use by the outer valgrind (default cachegrind).
74    --outer-args: use this as outer tool args. If the outer args are starting
75      with +, the given outer args are appended to the outer args predefined
76      by vg_perf.
77
78  Any tools named in --tools must be present in all directories specified
79  with --vg.  (This is not checked.)
80  Use EXTRA_REGTEST_OPTS to supply extra args for all tests
81END
82;
83
84# Test variables
85my $vgopts;             # valgrind options
86my $prog;               # test prog
87my $args;               # test prog args
88my $prereq;             # prerequisite test to satisfy before running test
89my $cleanup;            # cleanup command to run
90
91# Command line options
92my $n_reps = 1;         # Run each test $n_reps times and choose the best one.
93my @vgdirs;             # Dirs of the various Valgrinds being measured.
94my @tools = ("none", "memcheck");   # tools being measured
95
96# Outer valgrind to use, and args to use for it.
97# If this is set, --valgrind should be set to the installed inner valgrind,
98# and --valgrind-lib will be ignore
99my $outer_valgrind;
100my $outer_tool = "cachegrind";
101my $outer_args;
102
103
104my $num_tests_done   = 0;
105my $num_timings_done = 0;
106
107# Starting directory
108chomp(my $tests_dir = `pwd`);
109
110#----------------------------------------------------------------------------
111# Process command line, setup
112#----------------------------------------------------------------------------
113
114# If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
115#
116# 1. Can prepend "." onto programs to avoid trouble with users who don't have
117#    "." in their path (by making $dir = ".")
118# 2. Can prepend the current dir to make the command absolute to avoid
119#    subsequent trouble when we change directories.
120#
121# Also checks the program exists and is executable.
122sub validate_program ($$$$)
123{
124    my ($dir, $prog, $must_exist, $must_be_executable) = @_;
125
126    # If absolute path, leave it alone.  If relative, make it
127    # absolute -- by prepending current dir -- so we can change
128    # dirs and still use it.
129    $prog = "$dir/$prog" if ($prog !~ /^\//);
130    if ($must_exist) {
131        (-f $prog) or die "vg_perf: '$prog' not found or not a file ($dir)\n";
132    }
133    if ($must_be_executable) {
134        (-x $prog) or die "vg_perf: '$prog' not executable ($dir)\n";
135    }
136
137    return $prog;
138}
139
140sub add_vgdir($)
141{
142    my ($vgdir) = @_;
143    if ($vgdir !~ /^\//) { $vgdir = "$tests_dir/$vgdir"; }
144    push(@vgdirs, $vgdir);
145}
146
147sub process_command_line()
148{
149    my @fs;
150
151    for my $arg (@ARGV) {
152        if ($arg =~ /^-/) {
153            if ($arg =~ /^--reps=(\d+)$/) {
154                $n_reps = $1;
155                if ($n_reps < 1) { die "bad --reps value: $n_reps\n"; }
156            } elsif ($arg =~ /^--vg=(.+)$/) {
157                # Make dir absolute if not already
158                add_vgdir($1);
159            } elsif ($arg =~ /^--tools=(.+)$/) {
160                @tools = split(/,/, $1);
161            } elsif ($arg =~ /^--outer-valgrind=(.*)$/) {
162                $outer_valgrind = $1;
163            } elsif ($arg =~ /^--outer-tool=(.*)$/) {
164                $outer_tool = $1;
165            } elsif ($arg =~ /^--outer-args=(.*)$/) {
166                $outer_args = $1;
167            } else {
168                die $usage;
169            }
170        } else {
171            push(@fs, $arg);
172        }
173    }
174
175    # If no --vg options were specified, use the current tree.
176    if (0 == @vgdirs) {
177        add_vgdir($tests_dir);
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*args:\s*(.*)$/) {
206            $args = $1;
207        } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
208            $prereq = $1;
209        } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
210            $cleanup = $1;
211        } else {
212            die "Bad line in $f: $line\n";
213        }
214    }
215    close(INPUTFILE);
216
217    if (!defined $prog) {
218        $prog = "";     # allow no prog for testing error and --help cases
219    }
220    if (0 == @tools) {
221        die "vg_perf: missing 'tools' line in $f\n";
222    }
223}
224
225#----------------------------------------------------------------------------
226# Do one test
227#----------------------------------------------------------------------------
228# Since most of the program time is spent in system() calls, need this to
229# propagate a Ctrl-C enabling us to quit.
230sub mysystem($)
231{
232    my ($cmd) = @_;
233    my $retval = system($cmd);
234    if ($retval == 2) {
235        exit 1;
236    } else {
237        return $retval;
238    }
239}
240
241# Run program N times, return the best user time.  Use the POSIX
242# -p flag on /usr/bin/time so as to get something parseable on AIX.
243sub time_prog($$)
244{
245    my ($cmd, $n) = @_;
246    my $tmin = 999999;
247    for (my $i = 0; $i < $n; $i++) {
248        mysystem("echo '$cmd' > perf.cmd");
249        my $retval = mysystem("$cmd > perf.stdout 2> perf.stderr");
250        (0 == $retval) or
251            die "\n*** Command returned non-zero ($retval)"
252              . "\n*** See perf.{cmd,stdout,stderr} to determine what went wrong.\n";
253        my $out = `cat perf.stderr`;
254        ($out =~ /[Uu]ser +([\d\.]+)/) or
255            die "\n*** missing usertime in perf.stderr\n";
256        $tmin = $1 if ($1 < $tmin);
257    }
258
259    # Successful run; cleanup
260    unlink("perf.cmd");
261    unlink("perf.stderr");
262    unlink("perf.stdout");
263
264    # Avoid divisions by zero!
265    return (0 == $tmin ? 0.01 : $tmin);
266}
267
268sub do_one_test($$)
269{
270    my ($dir, $vgperf) = @_;
271    $vgperf =~ /^(.*)\.vgperf/;
272    my $name = $1;
273    my %first_tTool;    # For doing percentage speedups when comparing
274                        # multiple Valgrinds
275
276    read_vgperf_file($vgperf);
277
278    if (defined $prereq) {
279        if (system("$prereq") != 0) {
280            printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
281            return;
282        }
283    }
284
285    my $timecmd = "/usr/bin/time -p";
286
287    # Do the native run(s).
288    printf("-- $name --\n") if (@vgdirs > 1);
289    my $cmd     = "$timecmd $prog $args";
290    my $tNative = time_prog($cmd, $n_reps);
291
292    if (defined $outer_valgrind) {
293        $outer_valgrind = validate_program($tests_dir, $outer_valgrind, 1, 1);
294        foreach my $vgdir (@vgdirs) {
295            validate_program($vgdir, "./coregrind/valgrind", 1, 1);
296        }
297    } else {
298        foreach my $vgdir (@vgdirs) {
299            validate_program($vgdir, "./coregrind/valgrind", 1, 1);
300        }
301    }
302
303    # Pull any extra options (for example, --sanity-level=4)
304    # from $EXTRA_REGTEST_OPTS.
305    my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"};
306    my $extraopts = $maybe_extraopts ?  $maybe_extraopts  : "";
307
308    foreach my $vgdir (@vgdirs) {
309        # Benchmark name
310        printf("%-8s ", $name);
311
312        # Print the Valgrind version if we are measuring more than one.
313        my $vgdirname = $vgdir;
314        chomp($vgdirname = `basename $vgdir`);
315        printf("%-10s:", $vgdirname);
316
317        # Native execution time
318        printf("%4.2fs", $tNative);
319
320        foreach my $tool (@tools) {
321            # First two chars of toolname for abbreviation
322            my $tool_abbrev = $tool;
323            $tool_abbrev =~ s/(..).*/$1/;
324            printf("  %s:", $tool_abbrev);
325            my $run_outer_args = "";
326            if ((not defined $outer_args) || ($outer_args =~ /^\+/)) {
327                $run_outer_args =
328                      " -v --command-line-only=yes"
329                    . " --run-libc-freeres=no --sim-hints=enable-outer"
330                    . " --smc-check=all-non-file"
331                    . " --vgdb=no --trace-children=yes --read-var-info=no"
332                    . " --suppressions=../tests/outer_inner.supp"
333                    . " --memcheck:leak-check=full --memcheck:show-reachable=no"
334                    . " --cachegrind:cache-sim=yes --cachegrind:branch-sim=yes"
335                    . " --cachegrind:cachegrind-out-file=cachegrind.out.$vgdirname.$tool_abbrev.$name.%p"
336                    . " --callgrind:cache-sim=yes --callgrind:branch-sim=yes"
337                    . " --callgrind:dump-instr=yes --callgrind:collect-jumps=yes"
338                    . " --callgrind:callgrind-out-file=callgrind.out.$vgdirname.$tool_abbrev.$name.%p"
339                    . " ";
340                 if (defined $outer_args) {
341                    $outer_args =~ s/^\+(.*)/$1/;
342                    $run_outer_args = $run_outer_args . $outer_args;
343                 }
344            } else {
345                $run_outer_args = $outer_args;
346            }
347
348            my $vgsetup = "";
349            my $vgcmd   = "$vgdir/coregrind/valgrind "
350                        . "--command-line-only=yes --tool=$tool  $extraopts -q "
351                        . "--memcheck:leak-check=no "
352                        . "--trace-children=yes "
353                        . "$vgopts ";
354            # Do the tool run(s).
355            if (defined $outer_valgrind ) {
356                # in an outer-inner setup, only set VALGRIND_LIB_INNER
357                $vgsetup = "VALGRIND_LIB_INNER=$vgdir/.in_place ";
358                $vgcmd   = "$outer_valgrind "
359                         . "--tool=" . $outer_tool . " "
360                         . "--log-file=" . "$outer_tool.outer.log.$vgdirname.$tool_abbrev.$name.%p "
361                         . "$run_outer_args "
362                         . $vgcmd;
363            } else {
364                # Set both VALGRIND_LIB and VALGRIND_LIB_INNER
365                # in case this Valgrind was configured with --enable-inner.  And
366                # also VALGRINDLIB, which was the old name for the variable, to
367                # allow comparison against old Valgrind versions (eg. 2.4.X).
368                $vgsetup = "VALGRINDLIB=$vgdir/.in_place "
369                         . "VALGRIND_LIB=$vgdir/.in_place "
370                         . "VALGRIND_LIB_INNER=$vgdir/.in_place ";
371            }
372            my $cmd     = "$vgsetup $timecmd $vgcmd $prog $args";
373            my $tTool   = time_prog($cmd, $n_reps);
374            printf("%4.1fs (%4.1fx,", $tTool, $tTool/$tNative);
375
376            # If it's the first timing for this tool on this benchmark,
377            # record the time so we can get the percentage speedup of the
378            # subsequent Valgrinds.  Otherwise, compute and print
379            # the speedup.
380            if (not defined $first_tTool{$tool}) {
381                $first_tTool{$tool} = $tTool;
382                print(" -----)");
383            } else {
384                my $speedup = 100 - (100 * $tTool / $first_tTool{$tool});
385                printf("%5.1f%%)", $speedup);
386            }
387
388            $num_timings_done++;
389
390            if (defined $cleanup) {
391                (system("$cleanup") == 0) or
392                    print("  ($name cleanup operation failed: $cleanup)\n");
393            }
394        }
395        printf("\n");
396    }
397
398    $num_tests_done++;
399}
400
401#----------------------------------------------------------------------------
402# Test one directory (and any subdirs)
403#----------------------------------------------------------------------------
404sub test_one_dir($$);    # forward declaration
405
406sub test_one_dir($$)
407{
408    my ($dir, $prev_dirs) = @_;
409    $dir =~ s/\/$//;    # trim a trailing '/'
410
411    chomp(my $initial_dir = `pwd`);     # record where we started
412
413    # Ignore dirs into which we should not recurse.
414    if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
415
416    chdir($dir) or die "Could not change into $dir\n";
417
418    # Nb: Don't prepend a '/' to the base directory
419    my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
420    my $dashes = "-" x (50 - length $full_dir);
421
422    my @fs = glob "*";
423    my $found_tests = (0 != (grep { $_ =~ /\.vgperf$/ } @fs));
424
425    if ($found_tests) {
426        print "-- Running  tests in $full_dir $dashes\n";
427    }
428    foreach my $f (@fs) {
429        if (-d $f) {
430            test_one_dir($f, $full_dir);
431        } elsif ($f =~ /\.vgperf$/) {
432            do_one_test($full_dir, $f);
433        }
434    }
435    if ($found_tests) {
436        print "-- Finished tests in $full_dir $dashes\n";
437    }
438
439    chdir("$initial_dir");
440}
441
442#----------------------------------------------------------------------------
443# Summarise results
444#----------------------------------------------------------------------------
445sub summarise_results
446{
447    printf("\n== %d programs, %d timings =================\n\n",
448           $num_tests_done, $num_timings_done);
449}
450
451#----------------------------------------------------------------------------
452# main()
453#----------------------------------------------------------------------------
454sub warn_about_EXTRA_REGTEST_OPTS()
455{
456    print "WARNING: \$EXTRA_REGTEST_OPTS is set.  You probably don't want\n";
457    print "to run the perf tests with it set, unless you are doing some\n";
458    print "strange experiment, and/or you really know what you are doing.\n";
459    print "\n";
460}
461
462# nuke VALGRIND_OPTS
463$ENV{"VALGRIND_OPTS"} = "";
464
465if ($ENV{"EXTRA_REGTEST_OPTS"}) {
466    print "\n";
467    warn_about_EXTRA_REGTEST_OPTS();
468}
469
470my @fs = process_command_line();
471foreach my $f (@fs) {
472    if (-d $f) {
473        test_one_dir($f, "");
474    } else {
475        # Allow the .vgperf suffix to be given or omitted
476        if ($f =~ /.vgperf$/ && -r $f) {
477            # do nothing
478        } elsif (-r "$f.vgperf") {
479            $f = "$f.vgperf";
480        } else {
481            die "`$f' neither a directory nor a readable test file/name\n"
482        }
483        my $dir  = `dirname  $f`;   chomp $dir;
484        my $file = `basename $f`;   chomp $file;
485        chdir($dir) or die "Could not change into $dir\n";
486        do_one_test($dir, $file);
487        chdir($tests_dir);
488    }
489}
490summarise_results();
491
492if ($ENV{"EXTRA_REGTEST_OPTS"}) {
493    warn_about_EXTRA_REGTEST_OPTS();
494}
495
496##--------------------------------------------------------------------##
497##--- end                                                          ---##
498##--------------------------------------------------------------------##
499