| 1 | #!/usr/bin/perl -w |
| 2 | |
| 3 | use strict; |
| 4 | use Data::Dumper; |
| 5 | use File::Find; |
| 6 | use Cwd; |
| 7 | |
| 8 | $Data::Dumper::Terse = 1; |
| 9 | |
| 10 | my $root = undef; |
| 11 | my $entry = ''; |
| 12 | my $pass_count = 0; |
| 13 | my $total_count = 0; |
| 14 | |
| 15 | # first match "root: " |
| 16 | |
| 17 | # a line starting with "cwd:" marks the beginning of a new test case |
| 18 | # call process_entry() on each test case |
| 19 | while(<>) |
| 20 | { |
| 21 | if(m/^root:\s+(.*?)$/) |
| 22 | { |
| 23 | $root = $1; |
| 24 | } |
| 25 | elsif(m/^cwd:\s+(.*?)$/) |
| 26 | { |
| 27 | if(length($entry)) |
| 28 | { |
| 29 | &process_entry($root, $entry); |
| 30 | $entry = ''; |
| 31 | } |
| 32 | $entry .= $_; |
| 33 | } |
| 34 | else |
| 35 | { |
| 36 | $entry .= $_; |
| 37 | } |
| 38 | } |
| 39 | # don't forget last test case (no cwd: to mark end) |
| 40 | if(length($entry)) |
| 41 | { |
| 42 | &process_entry($root, $entry); |
| 43 | } |
| 44 | |
| 45 | # show totals |
| 46 | my $percentage = $pass_count * 100 / $total_count; |
| 47 | printf " * * * %d of %d unit-tests passed (%.1f percent) * * *\n", $pass_count, $total_count, $percentage; |
| 48 | |
| 49 | |
| 50 | sub process_entry |
| 51 | { |
| 52 | my ($root, $lines) = @_; |
| 53 | |
| 54 | # build an associative array of keys to value(s) |
| 55 | my $lines_seq = [split /\n/, $lines]; |
| 56 | #print Dumper($lines_seq); |
| 57 | my $tbl = { 'root' => $root, 'stdout' => [], 'stderr' => [] }; |
| 58 | my $line; |
| 59 | foreach $line (@$lines_seq) |
| 60 | { |
| 61 | if($line =~ m/^(\w+):\s+(.*)$/) |
| 62 | { |
| 63 | my $key = $1; |
| 64 | my $val = $2; |
| 65 | if(!exists($$tbl{$key})) |
| 66 | { $$tbl{$key} = ''; } |
| 67 | |
| 68 | if($key eq 'stdout' || $key eq 'stderr') # if type is @array |
| 69 | { |
| 70 | push @{$$tbl{$key}}, $val; |
| 71 | } |
| 72 | else |
| 73 | { |
| 74 | $$tbl{$key} .= $val; |
| 75 | } |
| 76 | } |
| 77 | else |
| 78 | { |
| 79 | print "ERROR: $line"; |
| 80 | } |
| 81 | } |
| 82 | #print Dumper($tbl); |
| 83 | #return; |
| 84 | |
| 85 | my $test_name = $$tbl{cwd}; |
| 86 | if ($test_name =~ m|.*/([a-zA-Z0-9-+_]+)$|) |
| 87 | { |
| 88 | $test_name = $1; |
| 89 | } |
| 90 | |
| 91 | #if make failed (exit was non-zero), mark this as a failure |
| 92 | if(0 ne $$tbl{exit}) |
| 93 | { |
| 94 | printf "%-40s FAIL Makefile failure\n", $test_name; |
| 95 | $total_count++; |
| 96 | return; |
| 97 | } |
| 98 | my $seen_result = 0; |
| 99 | |
| 100 | #if there was any output to stderr, mark this as a failure |
| 101 | foreach $line (@{$$tbl{stderr}}) |
| 102 | { |
| 103 | printf "%-40s FAIL spurious stderr failure: %s\n", $test_name, $line; |
| 104 | $total_count++; |
| 105 | return; |
| 106 | } |
| 107 | |
| 108 | # scan all stdout looking for lines that start with PASS or FAIL |
| 109 | foreach $line (@{$$tbl{stdout}}) |
| 110 | { |
| 111 | if($line =~ m/^(PASS|XPASS|FAIL|XFAIL).+/) |
| 112 | { |
| 113 | $total_count++; |
| 114 | if($line =~ m/^PASS.+/) |
| 115 | { |
| 116 | $pass_count++; |
| 117 | } |
| 118 | else |
| 119 | { |
| 120 | # only print failure lines |
| 121 | printf "%-40s %s\n", $test_name, $line; |
| 122 | } |
| 123 | $seen_result = 1; |
| 124 | } |
| 125 | } |
| 126 | if(!$seen_result) |
| 127 | { |
| 128 | printf "%-40s AMBIGIOUS missing [X]PASS/[X]FAIL\n", $test_name; |
| 129 | $total_count++; |
| 130 | } |
| 131 | } |