annotate test/runtests @ 201:4503199d56ba

Short circuit unneeded loops in pass4 Added debugging messages to deduce why pass4.c ran so slow. Short circuit unneeded looping yields approx. 70% reduction in execution time.
author William Astle <lost@l-w.ca>
date Fri, 16 Mar 2012 22:22:14 -0600
parents 3413a88f4d09
children 3cd8aa013b88
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
173
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
1 #!/usr/bin/perl
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
2 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
3 # This program will execute all programs in the "tests" directory. Each
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
4 # program is expected to produce output as follows on stdout:
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
5 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
6 # each line begins with a test name followed by whitespace followed by
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
7 # PASS, FAIL, or SKIP.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
8 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
9 # stderr is not redirected during testing. Any test that might spam stderr
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
10 # is encouraged to redirect it somewhere useful.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
11 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
12 # After each test script exits, a report indicating number passed, failed,
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
13 # and skipped is presented, or if the script failed to run.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
14 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
15 # Once all tests have been run, a report showing the grand total number of
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
16 # tests performed, passed, failed, and skipped.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
17 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
18 # Each test can be in any programming language that is appropriate for
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
19 # the task.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
20 #
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
21 # Each test can assume the current directory is the root of the source tree.
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
22
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
23 use File::Basename;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
24
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
25 $testdir = dirname($0) . '/tests';
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
26
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
27 opendir DH, $testdir;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
28 while ($fe = readdir DH)
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
29 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
30 next if ($fe =~ /^\./);
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
31 next if ($fe =~ /~$/);
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
32
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
33 $fn = $testdir . '/' . $fe;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
34
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
35 open P,"$fn|";
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
36 while (<P>)
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
37 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
38 chomp;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
39 ($tn, $ts) = split /\s+/;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
40 $testresults{$fe}{$tn} = $ts;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
41 if ($ts eq 'PASS')
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
42 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
43 $testspassed += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
44 $testresults{$fe}{'..passed'} += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
45 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
46 elsif ($ts eq 'FAIL')
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
47 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
48 $testsfailed += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
49 $testresults{$fe}{'..failed'} =+ 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
50 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
51 elsif ($ts eq 'SKIP')
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
52 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
53 $testsskipped += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
54 $testresults{$fe}{'..skipped'} += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
55 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
56 else
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
57 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
58 $testsunknown += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
59 $testresults{$fe}{'..unknown'} += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
60 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
61 $teststotal += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
62 $testresults{$fe}{'..total'} += 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
63 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
64 close P;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
65 $fdn = $fe;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
66 $fdn =~ s/\..+?$//;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
67 $rline = sprintf("%-25.25s: %d/%d (%d skipped, %d unknown, %d failed)", $fdn, $testresults{$fe}{'..passed'}, $testresults{$fe}{'..total'}, $testresults{$fe}{'..skipped'}, $testresults{$fe}{'..unknown'}, $testresults{$fe}{'..failed'});
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
68 print "$rline\n";
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
69 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
70 closedir DH;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
71
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
72 print sprintf("\n===================\nTotal: %d/%d (%d skipped, %d unknown, %d failed)\n", $testspassed, $teststotal, $testsskipped, $testsunknown, $testsfailed);
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
73
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
74 if ($testspassed < $teststotal)
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
75 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
76 print "\nThe following tests either failed or were otherwise dubious:\n";
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
77 foreach $i (keys %testresults)
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
78 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
79 $fdn = $i;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
80 $fdn =~ s/\..+?$//;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
81 foreach $j (keys %{ $testresults{$i} })
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
82 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
83 next if $j =~ /^\./;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
84 if ($testresults{$i}{$j} ne 'PASS')
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
85 {
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
86 print "$fdn/$j: $testresults{$i}{$j}\n";
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
87 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
88 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
89 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
90 exit 1;
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
91 }
3413a88f4d09 Added test framework
lost@l-w.ca
parents:
diff changeset
92 exit 0;