~ubuntu-branches/ubuntu/oneiric/valkyrie/oneiric

« back to all changes in this revision

Viewing changes to tests/vk_regtest

  • Committer: Bazaar Package Importer
  • Author(s): Hai Zaar
  • Date: 2009-05-06 14:48:00 UTC
  • Revision ID: james.westby@ubuntu.com-20090506144800-vw617m4d4qa2pam3
Tags: upstream-1.4.0
ImportĀ upstreamĀ versionĀ 1.4.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#! /usr/bin/perl
 
2
##--------------------------------------------------------------------##
 
3
##--- Valkyrie regression testing script                vk_regtest ---##
 
4
##--------------------------------------------------------------------##
 
5
 
 
6
#  This file is part of Valkyrie, a GUI for Valgrind.
 
7
#  http://www.valgrind.org
 
8
#
 
9
#  This file is based on Valgrind's test/vg_regtest
 
10
#  But rather than running $prog under valgrind,
 
11
#  just runs $prog directly (e.g. vk_logmerge)
 
12
#
 
13
#  Copyright (C) 2003 Nicholas Nethercote
 
14
#     njn@valgrind.org
 
15
#
 
16
#  This program is free software; you can redistribute it and/or
 
17
#  modify it under the terms of the GNU General Public License as
 
18
#  published by the Free Software Foundation; either version 2 of the
 
19
#  License, or (at your option) any later version.
 
20
#
 
21
#  This program is distributed in the hope that it will be useful, but
 
22
#  WITHOUT ANY WARRANTY; without even the implied warranty of
 
23
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
24
#  General Public License for more details.
 
25
#
 
26
#  You should have received a copy of the GNU General Public License
 
27
#  along with this program; if not, write to the Free Software
 
28
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 
29
#  02111-1307, USA.
 
30
#
 
31
#  The GNU General Public License is contained in the file COPYING.
 
32
 
 
33
#----------------------------------------------------------------------------
 
34
# usage: vk_regtest [options] <dirs | files>
 
35
#
 
36
# Options:
 
37
#   --all:      run tests in all subdirs
 
38
#
 
39
# The easiest way is to run all tests in valkyrie/ with (assuming you installed
 
40
# in $PREFIX):
 
41
#
 
42
#   $PREFIX/tests/vk_regtest --all
 
43
#
 
44
# You can specify individual files to test, or whole directories, or both.
 
45
# Directories are traversed recursively, except for ones named, for example, 
 
46
# CVS/ or docs/.
 
47
#
 
48
# Each test is defined in a file <test>.vgtest, containing one or more of the
 
49
# following lines, in any order:
 
50
#   - prog:   <prog to run>                         (compulsory)
 
51
#   - args:   <args for prog>                       (default: none)
 
52
#   - stdout_filter: <filter to run stdout through> (default: none)
 
53
#   - stderr_filter: <filter to run stderr through> (default: ./filter_stderr)
 
54
#   - prereq: <prerequisite command>                (default: none)
 
55
#   - cleanup: <post-test cleanup cmd to run>       (default: none)
 
56
#
 
57
# Note that filters are necessary for stderr results to filter out things that
 
58
# always change, eg. process id numbers.
 
59
#
 
60
# Expected stdout (filtered) is kept in <test>.stdout.exp[0-9]* (can be more
 
61
# than one expected output).  It can be missing if it would be empty.  Expected
 
62
# stderr (filtered) is kept in <test>.stderr.exp[0-9]*. 
 
63
#
 
64
# The prerequisite command, if present, must return 0 otherwise the test is
 
65
# skipped.
 
66
#
 
67
# If results don't match, the output can be found in <test>.std<strm>.out,
 
68
# and the diff between expected and actual in <test>.std<strm>.diff[0-9]*.
 
69
#
 
70
# Notes on adding regression tests for a new tool are in
 
71
# coregrind/docs/coregrind_tools.html.
 
72
#----------------------------------------------------------------------------
 
73
 
 
74
use warnings;
 
75
use strict;
 
76
 
 
77
#----------------------------------------------------------------------------
 
78
# Global vars
 
79
#----------------------------------------------------------------------------
 
80
my $usage="vk_regtest [--all]\n";
 
81
 
 
82
my $tmp="vk_regtest.tmp.$$";
 
83
 
 
84
# Test variables
 
85
my $prog;               # test prog
 
86
my $args;               # test prog args
 
87
my $stdout_filter;      # filter program to run stdout results file through
 
88
my $stderr_filter;      # filter program to run stderr results file through
 
89
my $prereq;             # prerequisite test to satisfy before running test
 
90
my $cleanup;            # cleanup command to run
 
91
 
 
92
my @failures;           # List of failed tests
 
93
 
 
94
my $num_tests_done      = 0;
 
95
my %num_failures        = (stderr => 0, stdout => 0);
 
96
 
 
97
chomp(my $tests_dir = `pwd`);
 
98
 
 
99
# default filter is the one named "filter_stderr" in the test's directory
 
100
my $default_stderr_filter = "filter_stderr";
 
101
 
 
102
 
 
103
#----------------------------------------------------------------------------
 
104
# Process command line, setup
 
105
#----------------------------------------------------------------------------
 
106
 
 
107
# If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
 
108
#
 
109
# 1. Can prepend "." onto programs to avoid trouble with users who don't have
 
110
#    "." in their path (by making $dir = ".")
 
111
# 2. Can prepend the current dir to make the command absolute to avoid
 
112
#    subsequent trouble when we change directories.
 
113
#
 
114
# Also checks the program exists and is executable.
 
115
sub validate_program ($$$$) 
 
116
{
 
117
    my ($dir, $prog, $must_exist, $must_be_executable) = @_;
 
118
 
 
119
    # If absolute path, leave it alone.  If relative, make it
 
120
    # absolute -- by prepending current dir -- so we can change
 
121
    # dirs and still use it.
 
122
    $prog = "$dir/$prog" if ($prog !~ /^\//);
 
123
    if ($must_exist) {
 
124
        (-f $prog) or die "vk_regtest: `$prog' not found or not a file ($dir)\n";
 
125
    }
 
126
    if ($must_be_executable) { 
 
127
        (-x $prog) or die "vk_regtest: `$prog' not executable ($dir)\n";
 
128
    }
 
129
 
 
130
    return $prog;
 
131
}
 
132
 
 
133
sub process_command_line() 
 
134
{
 
135
    my $alldirs = 0;
 
136
    my @fs;
 
137
    
 
138
    for my $arg (@ARGV) {
 
139
        if ($arg =~ /^-/) {
 
140
            if      ($arg =~ /^--all$/) {
 
141
                $alldirs = 1;
 
142
            } else {
 
143
                die $usage;
 
144
            }
 
145
        } else {
 
146
            push(@fs, $arg);
 
147
        }
 
148
    }
 
149
 
 
150
    if ($alldirs) {
 
151
        @fs = ();
 
152
        foreach my $f (glob "*") {
 
153
            push(@fs, $f) if (-d $f);
 
154
        }
 
155
    }
 
156
 
 
157
    (0 != @fs) or die "No test files or directories specified\n";
 
158
 
 
159
    return @fs;
 
160
}
 
161
 
 
162
#----------------------------------------------------------------------------
 
163
# Read a .vgtest file
 
164
#----------------------------------------------------------------------------
 
165
sub read_vgtest_file($)
 
166
{
 
167
    my ($f) = @_;
 
168
 
 
169
    # Defaults.
 
170
    ($prog, $args, $stdout_filter, $stderr_filter, $prereq, $cleanup)
 
171
      = (undef, "", undef, undef, undef, undef);
 
172
 
 
173
    # Every test directory must have a "filter_stderr"
 
174
    $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1);
 
175
 
 
176
    open(INPUTFILE, "< $f") || die "File $f not openable\n";
 
177
 
 
178
    while (my $line = <INPUTFILE>) {
 
179
        if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
 
180
            next;
 
181
        } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
 
182
            $prog = validate_program(".", $1, 0, 0);
 
183
        } elsif ($line =~ /^\s*args:\s*(.*)$/) {
 
184
            $args = $1;
 
185
        } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) {
 
186
            $stdout_filter = validate_program(".", $1, 1, 1);
 
187
        } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) {
 
188
            $stderr_filter = validate_program(".", $1, 1, 1);
 
189
        } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
 
190
            $prereq = $1;
 
191
        } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
 
192
            $cleanup = $1;
 
193
        } else {
 
194
            die "Bad line in $f: $line\n";
 
195
        }
 
196
    }
 
197
    close(INPUTFILE);
 
198
 
 
199
    if (!defined $prog) {
 
200
        $prog = "";     # allow no prog for testing error and --help cases
 
201
    }
 
202
}
 
203
 
 
204
#----------------------------------------------------------------------------
 
205
# Do one test
 
206
#----------------------------------------------------------------------------
 
207
# Since most of the program time is spent in system() calls, need this to
 
208
# propagate a Ctrl-C enabling us to quit.
 
209
sub mysystem($) 
 
210
{
 
211
    (system($_[0]) != 2) or exit 1;      # 2 is SIGINT
 
212
}
 
213
 
 
214
# Compare output against expected output;  it should match at least one of
 
215
# them.
 
216
sub do_diffs($$$$)
 
217
{
 
218
    my ($fullname, $name, $mid, $f_exps) = @_;
 
219
    
 
220
    for my $f_exp (@$f_exps) {
 
221
        (-r $f_exp) or die "Could not read `$f_exp'\n";
 
222
 
 
223
        my $n = "";
 
224
        if ($f_exp =~ /.*\.exp(\d*)/) {
 
225
            $n = $1;
 
226
        } else {
 
227
            $n = "";
 
228
            ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n";
 
229
        }
 
230
 
 
231
        #print("diff -C0 $f_exp $name.$mid.out > $name.$mid.diff$n\n");
 
232
        mysystem("diff -C0 $f_exp $name.$mid.out > $name.$mid.diff$n");
 
233
 
 
234
        if (not -s "$name.$mid.diff$n") {
 
235
            # A match;  remove .out and any previously created .diff files.
 
236
            unlink("$name.$mid.out");
 
237
            unlink(<$name.$mid.diff*>);
 
238
            return;
 
239
        }
 
240
    }
 
241
    # If we reach here, none of the .exp files matched.
 
242
    print "*** $name failed ($mid) ***\n";
 
243
    push(@failures, sprintf("%-40s ($mid)", "$fullname"));
 
244
    $num_failures{$mid}++;
 
245
}
 
246
 
 
247
sub do_one_test($$) 
 
248
{
 
249
    my ($dir, $vgtest) = @_;
 
250
    $vgtest =~ /^(.*)\.vgtest/;
 
251
    my $name = $1;
 
252
    my $fullname = "$dir/$name"; 
 
253
 
 
254
#    printf("do_one_test: $fullname $vgtest\n");
 
255
 
 
256
    read_vgtest_file($vgtest);
 
257
 
 
258
    if (defined $prereq) {
 
259
        if (system("$prereq") != 0) {
 
260
            printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
 
261
            return;
 
262
        }
 
263
    }
 
264
 
 
265
    printf("%-16s $prog $args\n", "$name:");
 
266
 
 
267
    mysystem("$prog $args > $name.stdout.out 2> $name.stderr.out");
 
268
 
 
269
    if (defined $stdout_filter) {
 
270
        mysystem("$stdout_filter < $name.stdout.out > $tmp");
 
271
        rename($tmp, "$name.stdout.out");
 
272
    }
 
273
 
 
274
    mysystem("$stderr_filter < $name.stderr.out > $tmp");
 
275
    rename($tmp, "$name.stderr.out");
 
276
 
 
277
 
 
278
    # Find all the .stdout.exp files.  If none, use /dev/null.
 
279
    my @stdout_exps = <$name.stdout.exp*>;
 
280
    @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps);
 
281
 
 
282
    # Find all the .stderr.exp files.  $name.stderr.exp must exist.
 
283
    my @stderr_exps = <$name.stderr.exp*>;
 
284
    (-r "$name.stderr.exp") or die "Could not read `$name.stderr.exp'\n";
 
285
    
 
286
    do_diffs($fullname, $name, "stdout", \@stdout_exps); 
 
287
    do_diffs($fullname, $name, "stderr", \@stderr_exps); 
 
288
 
 
289
    if (defined $cleanup) {
 
290
        (system("$cleanup") == 0) or 
 
291
            print("(cleanup operation failed: $cleanup)\n");
 
292
    }
 
293
 
 
294
    $num_tests_done++;
 
295
}
 
296
 
 
297
#----------------------------------------------------------------------------
 
298
# Test one directory (and any subdirs)
 
299
#----------------------------------------------------------------------------
 
300
sub test_one_dir($$);    # forward declaration
 
301
 
 
302
sub test_one_dir($$) 
 
303
{
 
304
    my ($dir, $prev_dirs) = @_;
 
305
    $dir =~ s/\/$//;    # trim a trailing '/'
 
306
 
 
307
#    printf("test_one_dir: $dir\n");
 
308
 
 
309
    # Ignore dirs into which we should not recurse.
 
310
    if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
 
311
 
 
312
    chdir($dir) or die "Could not change into $dir\n";
 
313
 
 
314
    # Nb: Don't prepend a '/' to the base directory
 
315
    my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
 
316
    my $dashes = "-" x (50 - length $full_dir);
 
317
 
 
318
    my @fs = glob "*";
 
319
    my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs));
 
320
 
 
321
    if ($found_tests) {
 
322
        print "-- Running  tests in $full_dir $dashes\n";
 
323
    }
 
324
    foreach my $f (@fs) {
 
325
        if (-d $f) {
 
326
            test_one_dir($f, $full_dir);
 
327
        } elsif ($f =~ /\.vgtest$/) {
 
328
            do_one_test($full_dir, $f);
 
329
        }
 
330
    }
 
331
    if ($found_tests) {
 
332
        print "-- Finished tests in $full_dir $dashes\n";
 
333
    }
 
334
 
 
335
    chdir("..");
 
336
}
 
337
 
 
338
#----------------------------------------------------------------------------
 
339
# Summarise results
 
340
#----------------------------------------------------------------------------
 
341
sub plural($)
 
342
{
 
343
   return ( $_[0] == 1 ? "" : "s" );
 
344
}
 
345
 
 
346
sub summarise_results 
 
347
{
 
348
    my $x = ( $num_tests_done == 1 ? "test" : "tests" );
 
349
    
 
350
    printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s =================\n", 
 
351
           $num_tests_done, plural($num_tests_done),
 
352
           $num_failures{"stderr"}, plural($num_failures{"stderr"}),
 
353
           $num_failures{"stdout"}, plural($num_failures{"stdout"}));
 
354
 
 
355
    foreach my $failure (@failures) {
 
356
        print "$failure\n";
 
357
    }
 
358
    print "\n";
 
359
}
 
360
 
 
361
#----------------------------------------------------------------------------
 
362
# main(), sort of
 
363
#----------------------------------------------------------------------------
 
364
 
 
365
# nuke VALGRIND_OPTS
 
366
$ENV{"VALGRIND_OPTS"} = "";
 
367
 
 
368
my @fs = process_command_line();
 
369
foreach my $f (@fs) {
 
370
    if (-d $f) {
 
371
        test_one_dir($f, "");
 
372
    } else { 
 
373
        # Allow the .vgtest suffix to be given or omitted
 
374
        if ($f =~ /.vgtest$/ && -r $f) {
 
375
            # do nothing
 
376
        } elsif (-r "$f.vgtest") {
 
377
            $f = "$f.vgtest";
 
378
        } else {
 
379
            die "`$f' neither a directory nor a readable test file/name\n"
 
380
        }
 
381
        my $dir  = `dirname  $f`;   chomp $dir;
 
382
        my $file = `basename $f`;   chomp $file;
 
383
        chdir($dir) or die "Could not change into $dir\n";
 
384
        do_one_test($dir, $file);
 
385
        chdir($tests_dir);
 
386
    }
 
387
}
 
388
summarise_results();
 
389
 
 
390
if (0 == $num_failures{"stdout"} && 0 == $num_failures{"stderr"}) {
 
391
    exit 0;
 
392
} else {
 
393
    exit 1;
 
394
}
 
395
 
 
396
##--------------------------------------------------------------------##
 
397
##--- end                                               vk_regtest ---##
 
398
##--------------------------------------------------------------------##