view release on metacpan or  search on metacpan

perlbench-run  view on Meta::CPAN

}
print "\n";


my $test;
for $test (@tests) {
    unless (open(T, $test)) {
	warn "Can't open $test: $!";
	next;
    }

    my $name = $test;
    $name =~ s,^benchmarks/,,;
    $name =~ s,\.t$,,;

    my $save_file = "$dir/$name/test.txt";
    mkpath(dirname($save_file), 0, 0755);
    open(SAVE, ">$save_file") || die "Can't create $save_file: $!";
    (my $save_file_link = $save_file) =~ s,^\Q$dir\E/,,;
    $save_file_link = htmlesc($save_file_link);

    my %prop;
    while (<T>) {
	print SAVE $_;
	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);
    close(SAVE) || die "Can't write $save_file: $!";

    printf "%-20s", $name;
    my $overlib_attr = "";
    if ($use_overlib && $prop{name}) {
	$overlib_attr = qq( onmouseover="return overlib('$prop{name}');" onmouseout="return nd();");
    }
    print INDEX qq( <tr>\n  <th align=left><a href="$save_file_link"$overlib_attr>) . htmlesc($name) . "</a></th>\n";

    my $scale;
    my $p;
    for my $p (@perls) {
	if ($p->{version} < $prop{'require'}) {
	    # Can't run test
	    printf "%8s", "N/A";
	    print INDEX "  <td>N/A</td>\n";
	    next;
	}

	my $res_file = "$dir/$name/" . $p->{label} . ".txt";
	mkpath(dirname($res_file), 0, 0755);
	open(RES, ">$res_file") || die "Can't create $res_file: $!";
	(my $res_file_link = $res_file) =~ s,^\Q$dir\E/,,;
	$res_file_link = htmlesc($res_file_link);

	my $points;
	my $popup_text = "";
	$p->run_cmd(*P, $test, $factor, $p->{empty_cycles});
	while (<P>) {
	    print RES $_;
	    if (/^Bench-Points:\s+(\S+)/) {
		$points = $1;
	    }
	    if (/^(?:\w+-Time|CPU|Cycles-Per-Sec|Loop-Overhead):/) {
		$popup_text .= "<br>" if length($popup_text);
		$popup_text .= $_;
		chomp($popup_text);
	    }
	}
	close(P);
	close(RES);

	my $overlib_attr = "";
	if ($use_overlib) {
	    $overlib_attr = qq( onmouseover="return overlib('$popup_text');" onmouseout="return nd();");
	}

	# present results
	unless (defined $points) {
	    printf "%8s", "-";
	    print INDEX qq(  <td><a href="$res_file_link"$overlib_attr>??</a></td>\n);
	    next;
	}
	unless ($opt_s) {
	    unless (defined $scale) {
		$scale = 100 / $points;
	    }
	    $points *= $scale;
	}
	printf "%8.0f", $points;
	printf INDEX qq(  <td align=right><a href="%s"%s>%.0f</a></td>\n), $res_file_link, $overlib_attr, $points;
	$p->{point_sum} += $points;
	$p->{no_tests}++;
    }
    print INDEX " </tr>\n";
    print "\n";
}

print "\n";
printf "%-20s", "AVERAGE";
for my $p (@perls) {
    printf "%8.0f", $p->{point_sum} / $p->{no_tests};
}
print INDEX " <tr>\n";
print INDEX "  <th align=left>Average</th>\n";
for my $p (@perls) {
    printf INDEX qq(  <td align=right>%.0f</td>\n), $p->{point_sum} / $p->{no_tests};
}
print INDEX " </tr>\n";

print INDEX "</table>\n";
print INDEX "<p><small>Higher numbers are better. 200 is twice as fast as 100.</small></p>\n";

print INDEX "<h2>Configuration summary</h2>\n";
print INDEX "<p>Test ran on a $^O machine";
if ($^O ne "MSWin32") {
    my $uname = `uname -a`;
    if ($uname) {
	print INDEX qq( that reports its uname as ") . htmlesc($uname) . qq(");
    }
}
print INDEX ".\n";
print INDEX " Test run completed at " . substr(time2iso(), 11) . ".\n";
print INDEX "</p>\n";

print INDEX "<table border=1>\n";
print INDEX " <tr>\n  <th>&nbsp</th>\n";
for my $p (@perls) {
    my $h = htmlesc($p->{label});
    print INDEX qq(  <th><a href="CONFIG-$h.txt">$h</a></th>\n);
}
for my $k ("name", "version", "path") {
    print INDEX " <tr>\n  <th>$k</th>\n";
    for my $p (@perls) {
	print INDEX "  <td>" . htmlesc($p->{$k}) . "</td>\n";