@@ -100,13 +100,6 @@ sub read_descr {
100
100
return $line ;
101
101
}
102
102
103
- my %descrs ;
104
- my $descrlen = 4; # "Test"
105
- for my $t (@subtests ) {
106
- $descrs {$t } = $shorttests {$t }." : " .read_descr(" $resultsdir /$t .descr" );
107
- $descrlen = length $descrs {$t } if length $descrs {$t }>$descrlen ;
108
- }
109
-
110
103
sub have_duplicate {
111
104
my %seen ;
112
105
for (@_ ) {
@@ -122,54 +115,65 @@ sub have_slash {
122
115
return 0;
123
116
}
124
117
125
- my %newdirabbrevs = %dirabbrevs ;
126
- while (!have_duplicate(values %newdirabbrevs )) {
127
- %dirabbrevs = %newdirabbrevs ;
128
- last if !have_slash(values %dirabbrevs );
129
- %newdirabbrevs = %dirabbrevs ;
130
- for (values %newdirabbrevs ) {
131
- s { ^[^/]*/} {} ;
118
+ sub print_default_results {
119
+ my %descrs ;
120
+ my $descrlen = 4; # "Test"
121
+ for my $t (@subtests ) {
122
+ $descrs {$t } = $shorttests {$t }." : " .read_descr(" $resultsdir /$t .descr" );
123
+ $descrlen = length $descrs {$t } if length $descrs {$t }>$descrlen ;
132
124
}
133
- }
134
125
135
- my %times ;
136
- my @colwidth = ((0)x@dirs );
137
- for my $i (0..$#dirs ) {
138
- my $d = $dirs [$i ];
139
- my $w = length (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
140
- $colwidth [$i ] = $w if $w > $colwidth [$i ];
141
- }
142
- for my $t (@subtests ) {
143
- my $firstr ;
126
+ my %newdirabbrevs = %dirabbrevs ;
127
+ while (!have_duplicate(values %newdirabbrevs )) {
128
+ %dirabbrevs = %newdirabbrevs ;
129
+ last if !have_slash(values %dirabbrevs );
130
+ %newdirabbrevs = %dirabbrevs ;
131
+ for (values %newdirabbrevs ) {
132
+ s { ^[^/]*/} {} ;
133
+ }
134
+ }
135
+
136
+ my %times ;
137
+ my @colwidth = ((0)x@dirs );
144
138
for my $i (0..$#dirs ) {
145
139
my $d = $dirs [$i ];
146
- $times {$prefixes {$d }.$t } = [get_times(" $resultsdir /$prefixes {$d }$t .times" )];
147
- my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
148
- my $w = length format_times($r ,$u ,$s ,$firstr );
140
+ my $w = length (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
149
141
$colwidth [$i ] = $w if $w > $colwidth [$i ];
150
- $firstr = $r unless defined $firstr ;
151
142
}
152
- }
153
- my $totalwidth = 3*@dirs +$descrlen ;
154
- $totalwidth += $_ for (@colwidth );
155
-
156
- binmode STDOUT , " :utf8" or die " PANIC on binmode: $! " ;
143
+ for my $t (@subtests ) {
144
+ my $firstr ;
145
+ for my $i (0..$#dirs ) {
146
+ my $d = $dirs [$i ];
147
+ $times {$prefixes {$d }.$t } = [get_times(" $resultsdir /$prefixes {$d }$t .times" )];
148
+ my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
149
+ my $w = length format_times($r ,$u ,$s ,$firstr );
150
+ $colwidth [$i ] = $w if $w > $colwidth [$i ];
151
+ $firstr = $r unless defined $firstr ;
152
+ }
153
+ }
154
+ my $totalwidth = 3*@dirs +$descrlen ;
155
+ $totalwidth += $_ for (@colwidth );
157
156
158
- printf " %-${descrlen} s" , " Test" ;
159
- for my $i (0..$#dirs ) {
160
- my $d = $dirs [$i ];
161
- printf " %-$colwidth [$i ]s" , (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
162
- }
163
- print " \n " ;
164
- print " -" x$totalwidth , " \n " ;
165
- for my $t (@subtests ) {
166
- printf " %-${descrlen} s" , $descrs {$t };
167
- my $firstr ;
157
+ printf " %-${descrlen} s" , " Test" ;
168
158
for my $i (0..$#dirs ) {
169
159
my $d = $dirs [$i ];
170
- my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
171
- printf " %-$colwidth [$i ]s" , format_times($r ,$u ,$s ,$firstr );
172
- $firstr = $r unless defined $firstr ;
160
+ printf " %-$colwidth [$i ]s" , (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
173
161
}
174
162
print " \n " ;
163
+ print " -" x$totalwidth , " \n " ;
164
+ for my $t (@subtests ) {
165
+ printf " %-${descrlen} s" , $descrs {$t };
166
+ my $firstr ;
167
+ for my $i (0..$#dirs ) {
168
+ my $d = $dirs [$i ];
169
+ my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
170
+ printf " %-$colwidth [$i ]s" , format_times($r ,$u ,$s ,$firstr );
171
+ $firstr = $r unless defined $firstr ;
172
+ }
173
+ print " \n " ;
174
+ }
175
175
}
176
+
177
+ binmode STDOUT , " :utf8" or die " PANIC on binmode: $! " ;
178
+
179
+ print_default_results();
0 commit comments