+
+# grind_print_compact(): like grind_print(), but display a single perl
+# in a compact form. Has an additional arg, $which_perl, which specifies
+# which perl to display.
+#
+# Arguments are of the form:
+# $results->{benchmark_name}{perl_label}{field_name} = N
+# $averages->{perl_label}{field_name} = M
+# $perls = [ [ perl-exe, perl-label ], ... ]
+# $tests->{test_name}{desc => ..., ...}
+# $order = [ 'foo::bar1', ... ] # order to display tests
+
+sub grind_print_compact {
+ my ($results, $averages, $which_perl, $perls, $tests, $order) = @_;
+
+ # Print standard header.
+ grind_blurb($perls);
+
+ print "\nResults for $perls->[$which_perl][1]\n\n";
+
+ my @test_names = sorted_test_names($results, $order, $perls);
+
+ # Dump the results for each test.
+
+ my @fields = qw( Ir Dr Dw
+ COND IND
+ COND_m IND_m
+ Ir_m1 Dr_m1 Dw_m1
+ Ir_mm Dr_mm Dw_mm
+ );
+ if ($OPTS{fields}) {
+ @fields = grep exists $OPTS{fields}{$_}, @fields;
+ }
+
+ # calculate the the max width of the test names
+
+ my $name_width = 0;
+ for (@test_names) {
+ $name_width = length if length > $name_width;
+ }
+
+ # Calculate the widths of the data columns
+
+ my @widths = map length, @fields;
+
+ for my $test (@test_names) {
+ my $res = ($test eq 'AVERAGE') ? $averages : $results->{$test};
+ $res = $res->{$perls->[$which_perl][1]};
+ for my $i (0..$#fields) {
+ my $l = length grind_format_cell($res->{$fields[$i]}, 1);
+ $widths[$i] = $l if $l > $widths[$i];
+ }
+ }
+
+ # Print header
+
+ printf " %*s", $widths[$_], $fields[$_] for 0..$#fields;
+ print "\n";
+ printf " %*s", $_, ('-' x $_) for @widths;
+ print "\n";
+
+ # Print the results for each test
+
+ for my $test_name (@test_names) {
+ my $doing_ave = ($test_name eq 'AVERAGE');
+ my $res = $doing_ave ? $averages : $results->{$test_name};
+ $res = $res->{$perls->[$which_perl][1]};
+ my $desc = $doing_ave
+ ? $test_name
+ : sprintf "%-*s %s", $name_width, $test_name,
+ $tests->{$test_name}{desc};
+
+ for my $i (0..$#fields) {
+ print " ", grind_format_cell($res->{$fields[$i]}, $widths[$i]);
+ }
+ print " $desc\n";
+ }
+}
+
+