Home | History | Annotate | Download | only in perf 
      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 (at] 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 
     48 use warnings;
     49 use strict;
     50 
     51 #----------------------------------------------------------------------------
     52 # Global vars
     53 #----------------------------------------------------------------------------
     54 my $usage = <<END
     55 usage: 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.)
     67 END
     68 ;
     69 
     70 # Test variables
     71 my $vgopts;             # valgrind options
     72 my $prog;               # test prog
     73 my $args;               # test prog args
     74 my $prereq;             # prerequisite test to satisfy before running test
     75 my $cleanup;            # cleanup command to run
     76 
     77 # Command line options
     78 my $n_reps = 1;         # Run each test $n_reps times and choose the best one.
     79 my @vgdirs;             # Dirs of the various Valgrinds being measured.
     80 my @tools = ("none", "memcheck");   # tools being measured
     81 
     82 my $num_tests_done   = 0;
     83 my $num_timings_done = 0;
     84 
     85 # Starting directory
     86 chomp(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.
    100 sub 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 
    118 sub 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 
    126 sub 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 #----------------------------------------------------------------------------
    161 sub 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.
    203 sub 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.
    216 sub 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 
    235 sub 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 #----------------------------------------------------------------------------
    321 sub test_one_dir($$);    # forward declaration
    322 
    323 sub 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 #----------------------------------------------------------------------------
    362 sub 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 
    375 my @fs = process_command_line();
    376 foreach 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 }
    395 summarise_results();
    396 
    397 ##--------------------------------------------------------------------##
    398 ##--- end                                                          ---##
    399 ##--------------------------------------------------------------------##
    400