Mercurial > hg > index.cgi
annotate test/runtests @ 583:000381ee2d5c default tip
Guard against single operand multiplication when detecting like terms
This *shouldn't* happen, but it apparently does in some pathological cases
so guard against a single operand multiplication to prevent a crash.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Mon, 04 Nov 2024 23:48:23 -0700 |
| parents | 3cd8aa013b88 |
| children |
| rev | line source |
|---|---|
|
448
3cd8aa013b88
Change the perl invocations for the test bits to use /usr/bin/env
William Astle <lost@l-w.ca>
parents:
173
diff
changeset
|
1 #!/usr/bin/env perl |
| 173 | 2 # |
| 3 # This program will execute all programs in the "tests" directory. Each | |
| 4 # program is expected to produce output as follows on stdout: | |
| 5 # | |
| 6 # each line begins with a test name followed by whitespace followed by | |
| 7 # PASS, FAIL, or SKIP. | |
| 8 # | |
| 9 # stderr is not redirected during testing. Any test that might spam stderr | |
| 10 # is encouraged to redirect it somewhere useful. | |
| 11 # | |
| 12 # After each test script exits, a report indicating number passed, failed, | |
| 13 # and skipped is presented, or if the script failed to run. | |
| 14 # | |
| 15 # Once all tests have been run, a report showing the grand total number of | |
| 16 # tests performed, passed, failed, and skipped. | |
| 17 # | |
| 18 # Each test can be in any programming language that is appropriate for | |
| 19 # the task. | |
| 20 # | |
| 21 # Each test can assume the current directory is the root of the source tree. | |
| 22 | |
| 23 use File::Basename; | |
| 24 | |
| 25 $testdir = dirname($0) . '/tests'; | |
| 26 | |
| 27 opendir DH, $testdir; | |
| 28 while ($fe = readdir DH) | |
| 29 { | |
| 30 next if ($fe =~ /^\./); | |
| 31 next if ($fe =~ /~$/); | |
| 32 | |
| 33 $fn = $testdir . '/' . $fe; | |
| 34 | |
| 35 open P,"$fn|"; | |
| 36 while (<P>) | |
| 37 { | |
| 38 chomp; | |
| 39 ($tn, $ts) = split /\s+/; | |
| 40 $testresults{$fe}{$tn} = $ts; | |
| 41 if ($ts eq 'PASS') | |
| 42 { | |
| 43 $testspassed += 1; | |
| 44 $testresults{$fe}{'..passed'} += 1; | |
| 45 } | |
| 46 elsif ($ts eq 'FAIL') | |
| 47 { | |
| 48 $testsfailed += 1; | |
| 49 $testresults{$fe}{'..failed'} =+ 1; | |
| 50 } | |
| 51 elsif ($ts eq 'SKIP') | |
| 52 { | |
| 53 $testsskipped += 1; | |
| 54 $testresults{$fe}{'..skipped'} += 1; | |
| 55 } | |
| 56 else | |
| 57 { | |
| 58 $testsunknown += 1; | |
| 59 $testresults{$fe}{'..unknown'} += 1; | |
| 60 } | |
| 61 $teststotal += 1; | |
| 62 $testresults{$fe}{'..total'} += 1; | |
| 63 } | |
| 64 close P; | |
| 65 $fdn = $fe; | |
| 66 $fdn =~ s/\..+?$//; | |
| 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'}); | |
| 68 print "$rline\n"; | |
| 69 } | |
| 70 closedir DH; | |
| 71 | |
| 72 print sprintf("\n===================\nTotal: %d/%d (%d skipped, %d unknown, %d failed)\n", $testspassed, $teststotal, $testsskipped, $testsunknown, $testsfailed); | |
| 73 | |
| 74 if ($testspassed < $teststotal) | |
| 75 { | |
| 76 print "\nThe following tests either failed or were otherwise dubious:\n"; | |
| 77 foreach $i (keys %testresults) | |
| 78 { | |
| 79 $fdn = $i; | |
| 80 $fdn =~ s/\..+?$//; | |
| 81 foreach $j (keys %{ $testresults{$i} }) | |
| 82 { | |
| 83 next if $j =~ /^\./; | |
| 84 if ($testresults{$i}{$j} ne 'PASS') | |
| 85 { | |
| 86 print "$fdn/$j: $testresults{$i}{$j}\n"; | |
| 87 } | |
| 88 } | |
| 89 } | |
| 90 exit 1; | |
| 91 } | |
| 92 exit 0; |