1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
my @ignore_test_arg;
my $debug = 0;
GetOptions(
'ignore=s' => \@ignore_test_arg,
'debug=i' => \$debug,
);
@ignore_test_arg = map { split /\s*,\s*/ } @ignore_test_arg;
my @ignore_test;
foreach my $ita (@ignore_test_arg) {
my @sub_re = split /\s*:\s*/,$ita;
die "syntax error: $ita" if ($#sub_re > 2);
my @this_it;
for (my $i=0;$i<3;$i++) {
push @this_it,(((defined $sub_re[$i]) and ($sub_re[$i] ne '')) ? qr/^$sub_re[$i]$/ : qr/^.*$/);
}
push @ignore_test,\@this_it;
print "will ignore: " . join(':',@this_it) . "\n" if ($debug > 1);
}
my ($test_script,@planned,@ok,@test_msg,@tidx);
my %failed_test_summary;
my %architectures;
sub eval_test {
my @failed_tests;
my @failed_msgs;
for (my $i=0;$i<=$#ok;$i++) {
unless ($ok[$i]) {
push @failed_tests,$planned[$i];
push @failed_msgs,$test_msg[$i];
}
}
my $arch = $1 if ($ARGV =~ /_([^_\.]+)\.testsuite$/);
for (my $i=0; $i<=$#failed_tests; $i++) {
my @val_tuple = ($test_script,$failed_tests[$i],$arch);
my $ignore = 0;
foreach my $it (@ignore_test) {
my $this_ignore = 1;
for (my $i=0;$i<3;$i++) {
$this_ignore &= ($val_tuple[$i] =~ $it->[$i]);
}
if ($this_ignore) {
$ignore = 1;
print STDERR "ignored '" . join(':',@val_tuple) . "' due to '" . join(':',@{$it}) . "\n" if ($debug > 0);
last;
}
}
next if ($ignore);
# printf "%-20s %3d %s %s\n",$test_script,$failed_tests[$i],$failed_msgs[$i],$arch;
$architectures{$arch}=1 if ($#failed_tests>=0);
$failed_test_summary{$test_script}->{$failed_tests[$i]}->{$arch}=1;
}
}
while (<>) {
if (/^(t\/.*\.t) \.+\s*skipped:/) {
eval_test() if ((defined $test_script) and ($#planned >= 0));
$test_script=undef;
@planned=();
@test_msg=();
@ok=();
@tidx=();
next;
}
if (/^(t\/.*\.t) \.+\s*$/) {
eval_test() if ((defined $test_script) and ($#planned >= 0));
$test_script=$1;
@planned=();
@test_msg=();
@ok=();
@tidx=();
next;
}
if (/^(\d+)\.\.(\d+)/) {
warn "planned was not empty" if ($#planned>=0);
@planned=$1 .. $2;
@ok = (0) x ($#planned+1);
@test_msg=('') x ($#planned+1);
for (my $i=0;$i<=$#planned;$i++) {
$tidx[$planned[$i]]=$i;
}
next;
}
next unless ((defined $test_script) and ($#planned >= 0));
if (/^ok\s*(\d+)\s*(.*)/) {
my $tidx=$tidx[$1];
$ok[$tidx]=1;
$test_msg[$tidx]=$2 unless ($2 =~ /^\s*$/);
}
}
eval_test() if ((defined $test_script) and ($#planned >= 0));
my @architectures = sort keys %architectures;
my $summary_fstring = '%-20s %3d';
foreach (@architectures) {
$summary_fstring .= ' %' . length($_) . 's';
}
$summary_fstring.="\n";
foreach my $tst (sort keys %failed_test_summary) {
foreach my $stst (sort { $a <=> $b } keys %{$failed_test_summary{$tst}}) {
my @farchitectures= map { ($failed_test_summary{$tst}->{$stst}->{$_} ? $_ : '') } @architectures;
printf $summary_fstring,$tst,$stst,@farchitectures;
}
}
|
