annotate test/runtests @ 273:1409debcb1a0

Fix crash on listing when nested noexpand macros are used Macros flagged noexpand were causing a segfault during listing. The problem was incorrect accounting for nesting levels for noexpand macros causing the listing handler to fall off the end of the program in certain circumstances and in other circumstances it would fail to suppress expansion. Both the segfault in the case of misbehaviour and the misbhaviour itself are corrected with this update. If you do not use nested noexpand macros, this bug has no effect.
author William Astle <lost@l-w.ca>
date Sat, 25 May 2013 13:35:46 -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;