#!/usr/bin/perl -w

# $Id: bench,v 1.7 1998/01/07 10:05:20 aas Exp $

require 5.002;
use strict;

$| = 1;

use Getopt::Std;
use vars qw($opt_v $opt_c $opt_t $opt_s);
getopts("vc:t:s") or usage();

my $VERBOSE = $opt_v;

my @perls;
for (@ARGV) {
   unless (-x $_) {
	warn "Not executable $_\n";
	next;
   }
   my $version = `$_ -e 'print "This is perl ", \$]+0, "\n"'`;
   chomp $version;
   unless ($version =~ /^This is perl (\d+.\d+)/) {
	warn "$_ does not appear to be a working perl\n";
	next;
   }
   push(@perls, {path    => $_,
                 version => $1+0
                });
}

usage() unless @perls;

# Show perl configurations
my $no = "A";
my $p;
for $p (@perls)
{
    print "\n" unless $no eq "A";
    print "$no) perl-$p->{version}\n";
	   printf "\t%-11s = %s\n", "path", $p->{path};
    if ($p->{version} >= 5) {
	# The perl should have Configure support.  Try to extract
	# compiler info.
	my $prog = 'use Config; Config::config_vars(qw(cc optimize ccflags usemymalloc))';
        open(CONFIG, "$p->{path} -e '$prog'|") or die;
	while (<CONFIG>) {
	   next unless /^(\w+)='([^']+)'/;  #' #
           $p->{$1} = $2;
	   printf "\t%-11s = %s\n", $1, $2;
        }
    }
    $no++;
}

my $factor = $opt_c;
unless ($factor) {
    $factor = `$^X cpu_factor`;
    chomp($factor);
    die "Can't calculate cpu speed factor" unless $factor;
}

print "\nCPU SPEED FACTOR = $factor\n" if $VERBOSE;

# Try to run tests
die "No test directory found" unless -d 't';

my @tests;

use File::Find;
find(sub { /\.t$/ && push(@tests, $File::Find::name) }, "t");
if ($opt_t) {
    @tests = grep /$opt_t/o, @tests;
}
@tests = sort @tests;

# Try to run the empty test in order to time the loop
for $p (@perls) {
    my $perl = $p->{path};
    print "Timing empty loop for perl-$p->{version}\n" if $VERBOSE;
    open(P, "$perl empty.t $factor|") or die;
    while (<P>) {
        next unless /^CYCLES\/SEC:\s*(\S+)/;
        $p->{empty_cycles} = int($1);
	print if $VERBOSE;
    }
    close(P);
    die "Could not determinces empty test speed for $perl"
        unless  $p->{empty_cycles};
    $p->{point_sum} = 0;
}

unless ($VERBOSE) {
    $no = "A";
    print "\n";
    print " " x 20;
    for $p (@perls) {
	printf "%8s", $no;
	$no++;
    }
    print "\n";

    print " " x 20;
    for $p (@perls) {
	printf "%8s", "----";
    }
    print "\n";
}

my $test;
for $test (@tests) {
    unless (open(T, $test)) {
	warn "Can't open $test: $!";
	next;
    }
    my %prop;
    my $lines = 20;
    while (<T>) {
	last unless $lines--;
	next unless /^\#\s*(\w+)\s*:\s*(.*)/;
	my($k,$v) = (lc($1), $2);
	
	if (defined $prop{$k}) {
	    $prop{$k} .= "\n$v";
	} else {
	    $prop{$k} = $v;
	}
    }
    close(T);

    if ($VERBOSE) {
        print "Test properties:\n";
	for (keys %prop) {
	    print "\t$_ = $prop{$_}\n";
	}
    }

    my $name = $test;
    $name =~ s,^t/,,;
    $name =~ s,\.t$,,;
    printf "%-20s", $name unless $VERBOSE;

    my $scale;
    my $p;
    for $p (@perls) {
        my $perl = $p->{path};
	if ($p->{version} < $prop{'require'}) {
	    # Can't run test
	    if ($VERBOSE) {
		print "Perl-$p->{version} can't run the test\n";
	    } else {
		printf "%8s", "N/A";
	    }
	    next;
	}
        my $cmd = "$perl $test $factor $p->{empty_cycles}";
	my $points = 0;
        print "Running '$cmd'...\n" if $VERBOSE;
	open(P, "$cmd|") or die;
	while (<P>) {
	    print ">>> $_" if $VERBOSE;
	    if (/^BENCH POINTS:\s+(\S+)/) {
		$points = $1;
	    }
	}
	close(P);

	unless ($VERBOSE) {
	    # present results
	    unless ($opt_s) {
		unless (defined $scale) {
		    $scale = 100 / $points;
		}
		$points *= $scale;
	    }
	    printf "%8.0f", $points;
	    $p->{point_sum} += $points;
	    $p->{no_tests}++;
	}
    }
    print "\n" unless $VERBOSE;
}

unless ($VERBOSE) {
    print "\n";
    printf "%-20s", "AVERAGE";
    for $p (@perls) {
        printf "%8.0f", $p->{point_sum} / $p->{no_tests};
    }
    print "\n";
}


sub usage
{
    $0 =~ s,.*/,,;
    die "Usage: $0 [options] <perl1> <perl2>...\n";
}

