]>
Commit | Line | Data |
---|---|---|
412ebb8e A |
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 there was any output to stderr, mark this as a failure | |
92 | my $some_errors = 0; | |
93 | foreach $line (@{$$tbl{stderr}}) | |
94 | { | |
95 | printf "%-40s FAIL spurious stderr failure: %s\n", $test_name, $line; | |
96 | $total_count++; | |
97 | $some_errors = 1; | |
98 | } | |
99 | if ( $some_errors ) | |
100 | { | |
101 | return; | |
102 | } | |
103 | ||
104 | #if make failed (exit was non-zero), mark this as a failure | |
105 | if(0 ne $$tbl{exit}) | |
106 | { | |
107 | printf "%-40s FAIL Makefile failure\n", $test_name; | |
108 | $total_count++; | |
109 | return; | |
110 | } | |
111 | ||
112 | $pass_count++; | |
113 | $total_count++; | |
114 | } |