songsenand
/
cgal
mirror of https://github.com/CGAL/cgal
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
cgal/Benchmark/developer_scripts/cgal_bench

635 lines
15 KiB
Perl
Executable File
Raw Blame History

#!/usr/local/bin/perl -w
package Elinfo;
sub new {
bless { MINLEV => undef,
ATAB => {} }, shift;
}
package main;
use English;
use Getopt::Long;
use XML::Parser;
use Config;
my $benchFailed=0;
format =
-------------------------
@<<<<< bench failed
$benchFailed
.
my $help = 0;
my $verboseLevel = 0;
my $root = $ENV{ROOT};
my $benchDir = $root . '/bench';
my $dataDir = $benchDir . '/data';
my $databaseFile = $dataDir . '/benchDb.xml';
my $os = 'linux';
my $version = '2_4';
my %filter = ();
my $maxSlept = 30;
my $indentCnt = 0;
my $indentInc = 2;
my $statusCol = 73;
my $lineLength = 0;
my $seenEOL = 1;
my $isLog = 0;
my $isGenerate = 0;
$Getopt::Long::ignorecase = 0;
die
unless GetOptions("args=s" => \$extraArgs,
"databaseFile=s" => \$databaseFile,
"generate!" => \$isGenerate,
"help" => \$help,
"indent=i" => \$indentInc,
"log!" => \$isLog,
"filterName=s" => \$filter{'name'},
"os=s" => \$os,
"verbose=i" => \$verboseLevel,
"version=s" => \$version);
usage() if $help;
# Set destination directory:
if ($verboseLevel > 1) {
printf "OS: $os\n";
}
# Severity enumeration:
# 0 - stop execution
# 1 -
# 2 -
# 3 - stop bench
# 4 - failure
# 5 - warning
# 6 - information
my @errors =
(
{'code' => 0, svr => 6, usr => 0, msg => 'Really nothing!'},
{'code' => 1, svr => 0, usr => 0, msg => 'reserved'},
{'code' => 2, svr => 0, usr => 0, msg => 'reserved'},
{'code' => 3, svr => 3, usr => 0, msg => 'reserved'},
{'code' => 4, svr => 3, usr => 0, msg => 'reserved'},
{'code' => 5, svr => 3, usr => 0, msg => 'Time elapsed!'},
{'code' => 6, svr => 3, usr => 0, msg => 'Source file does not exist!'},
{'code' => 7, svr => 3, usr => 0, msg => 'Destination file does not exist!'},
{'code' => 8, svr => 4, usr => 1, msg => 'Snapshot is different than golden!'},
{'code' => 9, svr => 4, usr => 1, msg => 'At least one bench failed!'},
{'code' => 10, svr => 5, usr => 0, msg => 'Cannot read temporary file!'}
);
my ($errn, $errt, $ie);
my $maxSvr = 10;
my $curSvr = $maxSvr;
my @Attrs;
my %Files = ();
my %Clos = ();
my $elementRoot;
my $subform = ' @<<<<<<<<<<<<<<<<<<<<<<< @>>>>';
$databaseFile =$dataDir . '/' . $databaseFile unless -f $databaseFile;
die "Can't find file \"$databaseFile\"" unless -f $databaseFile;
doStart();
printEnv();
my $parser = new XML::Parser(ErrorContext => 2,
Handlers => {Start => \&start_handler,
End => \&end_handler,
Char => \&char_handler,
CdataStart => \&cdata_start,
CdataEnd => \&cdata_end
}
);
$parser->parsefile($databaseFile);
doExit(0);
################
## End of main
################
#
#
#
sub start_handler
{
my $xp = shift;
my $currentElement = shift; # innermost currently opened element
my $element;
my $parentEnable = 'true';
my $parentAttrTable = 0;
if (defined($xp->current_element)) {
$parentAttrTable = $Attrs[$#Attrs];
$parentEnable = $parentAttrTable->{'enable'};
}
# Create attributes:
$attrTable = {};
# Initialize attributes:
if (($currentElement ne 'file') && ($currentElement ne 'clo')) {
for $attr (keys %$parentAttrTable) {
$attrTable->{$attr} = $parentAttrTable->{$attr};
}
$attrTable->{'enable'} = $parentEnable;
}
push @Attrs, $attrTable;
# Update attributes:
while (@_) {
my $id = shift;
my $val = shift;
$val = $xp->xml_escape($val, "'");
$attrTable->{$id} = $val;
}
return if ($currentElement eq 'class');
if ($currentElement eq 'clo') {
processStartClo($attrTable);
return;
}
if ($currentElement eq 'file') {
processStartFile($attrTable);
return;
}
# Don't process if bench is disable:
return if ($attrTable->{'enable'} ne 'true');
# Process 'bench':
if ($currentElement eq 'bench') {
processStartBench($attrTable);
return;
}
# Disable it, if filter{name} has been specified and there is no match:
return if (defined($filter{'name'}) &&
($element !~ m/(?:^|\/)$filter{'name'}(?:$|\/)/));
# run the command
processStartCmd($currentElement, $attrTable);
}
#
#
#
sub end_handler
{
my $xp = shift;
my $currentElement = shift;
my $element = $currentElement;
my $attrTable = pop @Attrs;
my $parentAttrTable = 0;
$parentAttrTable = $Attrs[$#Attrs] if (defined($xp->current_element));
return if ($currentElement eq 'class');
return if ($currentElement eq 'file');
return if ($currentElement eq 'clo');
return if ($attrTable->{'enable'} ne 'true');
# Process 'bench':
if ($currentElement eq 'bench') {
processEndBench($parentAttrTable, $attrTable);
return;
}
# Disable it, if filter{name} has been specified and there is no match:
return if (defined($filter{'name'}) &&
($element !~ m/(?:^|\/)$filter{'name'}(?:$|\/)/));
# Process the command:
processEndCmd($currentElement, $parentAttrTable, $attrTable);
}
#
sub char_handler
{
my ($xp, $data) = @_;
}
#
sub cdata_start
{
my $xp = shift;
}
#
sub cdata_end
{
my $xp = shift;
}
#
sub showtab
{
my ($title, $table, $dosum) = @_;
my @list = sort keys %{$table};
if (@list) {
print "\n $title:\n";
my $item;
my $sum = 0;
foreach $item (@list) {
my $cnt = $table->{$item};
formline($subform, $item, $cnt);
print $ACCUMULATOR, "\n";
$ACCUMULATOR = '';
}
if ($dosum and @list > 1) {
print " =====\n";
formline($subform, '', $sum);
print $ACCUMULATOR, "\n";
$ACCUMULATOR = '';
}
}
}
#
sub usage {
printf "Usage: MakeHtmlPage [options]\n";
printf " -args <args>\tset additional arguments to bench program
-help\t\t\tprint this help message
-verbose <level>\tset verbose level to <level> on
-databaseFile <file>\tset database xml file to <file>
-filterName <name>\tselect <name> bench (and sub benches).\n";
exit(0);
}
#
sub processError
{
my ($errCode, $errMsg, $attrTable) = @_;
if (!$errors[$errCode]{usr} || $verboseLevel > 1) {
printInfo("$errMsg", 1) if $errMsg;
printInfo("$errors[$errCode]{msg}", 1);
}
my $svr = $errors[$errCode]{svr};
$attrTable->{'status'} = 'failed' if ($svr <= 4);
doExit($errCode) if ($svr == 0);
return $svr;
}
#
sub printStatus
{
my ($attrTable) = @_;
printInfo("Bench status", 0) if ($seenEOL);
my $statusIndentCnt = $statusCol - $lineLength;
my $fmt = '%' . $statusIndentCnt . 's';
my $spacing = sprintf($fmt, ' ');
printInfo($spacing . $attrTable->{'status'}, 1);
}
#
sub doStart
{
print scalar localtime; printf "\n";
}
#
sub doExit
{
print scalar localtime; printf "\n";
my $rc = shift;
write() if ($verboseLevel > 1 && $benchFailed > 0);
exit($rc);
}
#
sub printInfo
{
my ($line, $endOfLine) = @_;
return unless $verboseLevel;
if ($seenEOL && $indentCnt) {
my $fmt = '%' . $indentCnt . 's';
printf ($fmt, ' ');
$lineLength += $indentCnt;
}
print $line;
if ($endOfLine) {
printf "\n";
$seenEOL = 1;
$lineLength = 0;
} else {
$seenEOL = 0;
$lineLength += length $line;
}
}
#
sub processStartClo
{
my ($attrTable) = @_;
printInfo("Adding command-line option $attrTable->{'name'}", 1)
if ($verboseLevel > 1);
$Clos{$attrTable->{'name'}} = $attrTable;
}
#
sub processStartFile
{
my ($attrTable) = @_;
return if ($curSvr <= 1);
printInfo("Adding file $attrTable->{'name'}", 1) if ($verboseLevel > 1);
$Files{$attrTable->{'name'}} = $attrTable;
}
#
sub processStartBench
{
my ($attrTable) = @_;
return if ($curSvr <= 1);
printInfo("Performing bench", 1);
$attrTable->{'status'} = 'passed';
$indentCnt += $indentInc;
}
#
sub processStartCmd
{
my ($currentElement, $attrTable) = @_;
return if ($curSvr <= 3);
printInfo("Performing $currentElement ($attrTable->{'file'}) ", 0);
$attrTable->{'status'} = 'unknow';
$indentCnt += $indentInc;
my $fileAttrTable = $Files{$attrTable->{'file'}};
my $filename = $fileAttrTable->{'name'};
my $command = $currentElement;
@args = ();
push @args, $command;
foreach $clo (keys %Clos) {
$cmd = $Clos{$clo}->{'string'};
push @args, $cmd . $fileAttrTable->{$clo}
if exists($fileAttrTable->{$clo});
push @args, $cmd . $attrTable->{$clo} if exists($attrTable->{$clo});
}
push @args, $extraArgs if defined($extraArgs);
push @args, $filename;
# print command
printInfo("@args", 1) if ($verboseLevel > 1);
printInfo('.', 0);
printInfo("@args", 1);
if (1) {
$rc = 0xffff & system @args;
print("system(%s) returned %#04x: ", "@args", $rc) if ($verboseLevel > 1);
if ($rc == 0) {
print("ran with normal exit\n") if ($verboseLevel > 1);
} elsif ($rc == 0xff00) {
print "command failed : $!\n";
} elsif ($rc > 0x80) {
$rc >>= 8;
print "ran with non-zero exit status $rc\n";
} else {
print "ran with ";
if ($rc & 0x80) {
$rc &= ~0x80;
print "coredump from ";
}
print "signal $rc\n";
}
$attrTable->{'status'} = ($rc == 0) ? 'passed' : 'failed';
}
printInfo("", 1) if ($verboseLevel > 1);
}
#
sub updateParentStatus
{
my ($parentAttrTable, $attrTable) = @_;
$parentAttrTable->{'status'} = 'failed'
if ($attrTable->{'status'} eq 'failed');
$parentAttrTable->{'status'} = 'unknow'
if ($parentAttrTable->{'status'} eq 'passed') &&
($attrTable->{'status'} eq 'unknow');
}
#
sub processEndBench
{
my ($parentAttrTable, $attrTable) = @_;
return if ($curSvr < 1);
printInfo("Analyzing bench ", 0) if ($verboseLevel > 2);
printStatus($attrTable);
updateParentStatus($parentAttrTable, $attrTable) if ($parentAttrTable);
$curSvr = $maxSvr;
$indentCnt -= $indentInc;
}
#
sub processEndCmd
{
my ($currentElement, $parentAttrTable, $attrTable) = @_;
return if ($curSvr < 3);
printInfo("Analyzing $currentElement $attrTable->{'file'}", 1)
if ($verboseLevel > 2);
if ($attrTable->{'status'} ne 'failed') {
# do something
}
printStatus($attrTable);
updateParentStatus($parentAttrTable, $attrTable);
$benchFailed++ if ($attrTable->{'status'} eq 'failed');
$indentCnt -= $indentInc;
$curSvr = $maxSvr;
}
sub printEnv
{
# Compiler
# --------
OS_SWITCH: {
@infoLines = `cl -? 2>&1`, $compInfo = $infoLines[0], chop $compInfo,
$compName = 'cl', last OS_SWITCH if $OSNAME =~ /MSWin32/;
$compInfo = `gcc --version`, $compName = 'gcc',
last OS_SWITCH if $OSNAME =~ /Linux/i;
$compInfo = '', $compName = 'unrecognized';
}
printf("COMPILER NAME: $compName\n");
printf("COMPILER INFO: $compInfo\n");
# System
# ------
$sysInfo = `uname -a`;
printf("OS NAME: $OSNAME\n");
printf("OS INFO: $sysInfo\n");
# Hardware
# --------
@cpus = ();
$memSize = 'unknown';
$gfxBoard = 'unknown';
if ($OSNAME =~ /MSWin32/i) {
} elsif ($OSNAME =~ /IRIX/i) {
# Extract the information:
@infoLines = `hinv`;
# Initialize the fields
$numCpus = 0;
$cpuSpeed = 'unknown';
$cpuType = 'unknown';
$primDataCache = 'unknown';
$secDataCache = 'unknown';
$instCache = 'unknown';
# Parse:
for $record (@infoLines) {
if ($record =~ /([^\s])+ ([^\s]+) MHZ ([^\s]+) Processor/) {
$numCpus = $1;
$cpuSpeed = $2;
$cpuType = $3;
} elsif ($record =~ /Data cache size:[\s]+([^\n]*)/) {
$primDataCache = $1;
} elsif ($record =~ /Secondary cache size:[\s]+([^\n]*)/) {
$secDataCache = $1;
} elsif ($record =~ /Instruction cache size:[\s]+([^\n]*)/) {
$instCache = $1;
} elsif ($record =~ /Graphics board:[\s]+([^\n]*)/) {
$gfxBoard = $1;
} elsif ($record =~ /Main memory size:[\s]+([^\n]*)/) {
$memSize = $1;
}
}
# Update:
for $i (0 .. $numCpus-1) {
$cpus[$i]{'cpuSpeed'} = $cpuSpeed;
$cpus[$i]{'cpuType'} = $cpuType;
$cpus[$i]{'primDataCache'} = $primDataCache;
$cpus[$i]{'secDataCache'} = $secDataCache;
$cpus[$i]{'instCache'} = $instCache;
}
} elsif ($OSNAME =~ /linux/i) {
open CPUFILE, '/proc/cpuinfo' or die "Can't open file: /proc/cpuinfo\n";
@infoLines = <CPUFILE>;
close CPUFILE;
for $record (@infoLines) {
chop $record;
if ($record =~ /processor[\s]*:[\s]+([^\s]+)/) {
$i = $1;
$cpus[$i]{'cpuSpeed'} = 0;
$cpus[$i]{'cpuType'} = 0;
$cpus[$i]{'primDataCache'} = 0;
$cpus[$i]{'secDataCache'} = 0;
$cpus[$i]{'instCache'} = 0;
} elsif ($record =~ /cpu MHz[\s]*:[\s]+([^\s].*)/) {
$cpus[$i]{'cpuSpeed'} = $1 . ' MHz';
} elsif ($record =~ /model name[\s]*:[\s]+([^\s].*)/) {
$cpus[$i]{'cpuType'} = $1;
} elsif ($record =~ /cache size[\s]*:[\s]+([^\s].*)/) {
$cpus[$i]{'primDataCache'} = $1;
}
}
open MEMFILE, '/proc/meminfo' or die "Can't open file: /proc/meminfo\n";
@infoLines = <MEMFILE>;
close MEMFILE;
for $record (@infoLines) {
chop $record;
if ($record =~ /Mem:[\s]+([^\s]+)/) {
$memSize = int($1 / 1048576) . ' MBytes';
}
}
} elsif ($OSNAME =~ /Solaris/i) {
# Processor=`psrinfo -v | sed -n -e '1,4 s/.*The \(.*\)
# processor operates at \(.*\),/\2 \1/p'`
# Memory size=`prtconf -pv`:Memory.size[\s:]+(.*)
# Instruction cache=0x`prtconf -pv`:icache-size Bytes
# L1 data cache=0x`prtconf -pv`:dcache-size Bytes
# L2 data cache=0x`prtconf -pv`:ecache-size Bytes
}
for $i (0 .. $#cpus) {
print "PROCESSOR: $i\n";
print "CPU SPEED: $cpus[$i]{'cpuSpeed'}\n";
print "CPU TYPE: $cpus[$i]{'cpuType'}\n";
print "PRIMARY DATA CACHE: $cpus[$i]{'primDataCache'}\n";
print "SECONDARY DATA CACHE: $cpus[$i]{'secDataCache'}\n";
print "INSTRUCTION CACHE: $cpus[$i]{'instCache'}\n";
}
print "MEM SIZE: $memSize\n";
print "GFX BOARD: $gfxBoard\n";
# CGAL version
# ------------
$cgalVersion = 'unknown';
$cgalFile = "$ENV{CGALROOT}/include/CGAL/version.h";
if (open CGALFILE, $cgalFile) {
undef $/; # input record separator
$_ = <CGALFILE>; # whole file
if (/#define CGAL_VERSION\s+([^\s]+)/) {
$cgalVersion = $1;
}
}
print "CGAL VERSION: $cgalVersion\n";
# LEDA version
# ------------
$ledaVersion = 'unknown';
$ledaFile = "$ENV{LEDAROOT}/CHANGES";
$cgalMakeFile = "$ENV{CGAL_MAKEFILE}";
if (open CGALMAKEFILE, $cgalMakeFile) {
undef $/; # input record separator
$_ = <CGALMAKEFILE>; # whole file
if (/^(.*LEDA)\/incl/) {
$ledaFile = $1;
}
open LEDAFILE, $ledaFile or die "Can't open file: $ledaFile\n";
undef $/; # input record separator
$_ = <LEDAFILE>; # whole file
if (/#define __LEDA__\s+([^\s]+)/) {
$ledaVersion = $1;
}
}
print "LEDA VERSION: $ledaVersion\n";
# Qt version
# ----------
$qtVersion = 'unknown';
$qtFile = "$ENV{QTDIR}/README";
if (open QTFILE, $qtFile) {
undef $/; # input record separator
$_ = <QTFILE>; # whole file
if (/version\s+([^\s]+)/) {
$qtVersion = $1;
}
}
print "QT VERSION: $qtVersion\n";
}
# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End:
Reference in New Issue View Git Blame Copy Permalink