#!/usr/bin/perl -w use strict; use Data::Dumper; use Getopt::Long qw(:config no_ignore_case); use vars qw($help $directory $types $compare $compute $verbose $outFile $make $force $logFile $quiet $everything $atlasCommand $referenceFile $sumsFile $atlas); my $atlasCommandDefault="atlas"; my %options=('h' => \$help, 'e' => \$everything, 'A' => \$atlasCommand, 'a' => \$atlas, 'f' => \$force, 't' => \$types, 'q' => \$quiet, 'l' => \$logFile, 'm' => \$make, 'r' => \$referenceFile, 's' => \$sumsFile, 'd' => \$directory, 'c' => \$compute, 'o' => \$outFile, 'C' => \$compare, 'v' => \$verbose); my %innerClassNames=( 's' => 'splitInnerClass', 'c' => 'compactInnerClass', 'u' => 'unequalRankInnerClass', 'C' => 'complexInnerClass' ); GetOptions(\%options,qw(h! f! d=s c! C! v! o=s m! l=s i=s t=s q! e! a! s=s r=s A=s)); &help if $help; $types=init($types) if $types; $atlasCommand||=$atlasCommandDefault; if ($logFile){ print "Writing log file $logFile\n"; open(LOG,">$logFile") or die("Can't open log file $logFile for output\n"); } if ($everything){ &everything; }elsif ($atlas){ &runAtlas; }elsif ($make){ &make; }elsif ($compute){ &compute; }elsif ($compare){ &compare; }else{ &help; } sub everything{ print "Doing everything\n"; print LOG "Doing everything\n" if $logFile; &make; &runAtlas; &compute; &compare; &done; } sub compute{ unless ($directory){ print "You must include a directory with -d. See -h for a help file.\n"; exit; } unless ($outFile){ print "You must include an output file with -o. See -h for a help file.\n"; exit; } $directory =~ s/\/$//; print "Computing checksums, writing output to $outFile\n"; print LOG "Computing checksums, writing output to $outFile\n" if $logFile; my $files= `find $directory`; my @files = split "\n", $files; my $outFileTmp="$outFile"."tmp"; open(OUTFILE,">$outFileTmp")||die("Can not open $outFileTmp for writing.\n"); foreach my $file (@files){ chomp($file); $verbose and print "computing checksum for $file\n"; next unless ($file =~ /roots|coroots|rootdatum|cartan|kgb|smallblock|block|blocku|klbasis|kllist|wcells|wgraph/); # next if ($file =~ /E7|E8|E6/); # print "Doing $file\n"; my $md5out = `md5sum $file`; my @md5datum = split / / , $md5out; $file =~ s/$directory\///; my $outline = "$file $md5datum[0]\n"; print OUTFILE $outline; } close(OUTFILE); `sort $outFileTmp > $outFile`; unlink $outFileTmp; } sub runAtlas{ print "running $atlasCommand...\n"; print LOG "running $atlasCommand...\n" if $logFile; my $failure; if ($quiet) { $failure = system("$atlasCommand /dev/null 2>/dev/null"); } else { $failure = system("$atlasCommand ){ my ($file,$sum)=split ' ', $line; $sumsA{$file}=$sum; } close(IN); open(IN,"<$sumsFile") or die("Can't open $sumsFile for input\n"); foreach my $line (){ my ($file,$sum)=split ' ', $line; $sumsB{$file}=$sum; } close(IN); my (@onlyInA,@onlyInB,%conflicts,@agree); foreach my $key (keys(%sumsA)){ my $sumA=$sumsA{$key}; my $sumB=$sumsB{$key}; if (!$sumB){ push @onlyInA, $key; }elsif ($sumA ne $sumB){ $conflicts{$key}="$sumA $sumB"; }else{ push @agree, $key; } } foreach my $key (keys(%sumsB)){ my $sumA=$sumsA{$key}; my $sumB=$sumsB{$key}; if (!$sumA){ push @onlyInB, $key; }else{ push @agree, $key; } } print "Only in $referenceFile:\n"; print join "\n", @onlyInA; print "\n--------------------------\n"; print "Only in $sumsFile:\n"; print join "\n", @onlyInB; print "\n--------------------------\n"; print "Conflicts:\n"; print "File sum from $referenceFile sum from $sumsFile\n"; foreach my $key (keys(%conflicts)){ my $sums=$conflicts{$key}; print "$key $sums\n"; } if ($logFile){ print LOG "Only in $referenceFile:\n"; print LOG join "\n", @onlyInA; print LOG "\n--------------------------\n"; print LOG "Only in $sumsFile:\n"; print LOG join "\n", @onlyInB; print LOG "\n--------------------------\n"; print LOG "Conflicts:\n"; print LOG "File sum from $referenceFile sum from $sumsFile\n"; foreach my $key (keys(%conflicts)){ my $sums=$conflicts{$key}; print LOG "$key $sums\n"; } } } sub init{ my $a1="\ntype:A1\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,split\ndualrealforms:compact,split\nactual:1;0,1"; my $a2="\ntype:A2\ncovers:sc;ad\ninnerclass:s\nrealforms:split\ndualrealforms:compact,SU21\nactual:0,1\ntype:A2\ncovers:sc;ad\ninnerclass:c\nrealforms:compact,SU21\ndualrealforms:split\nactual:0;0\n"; my $a1a1="\ntype:A1.A1\ncovers:sc;ad\ninnerclass:C\nrealforms:complex\ndualrealforms:complex\nactual:0"; my $b2="\ntype:B2\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,SO41,split\ndualrealforms:compact,Sp11,split\nactual:2;2;0,1,2"; my $g2="\ntype:G2\ncovers:sc\ninnerclass:s\nrealforms:compact,split\ndualrealforms:compact,split\nactual:1;0,1"; my $a3="\ntype:A3\ncovers:sc;ad;2/4[intermediate]\ninnerclass:s\nrealforms:SL2H,split\ndualrealforms:compact,SU31,SU22\nactual:2;0,1,2\ntype:A3\ncovers:sc;ad;2/4[intermediate]\ninnerclass:c\nrealforms:compact,SU31,SU22\ndualrealforms:SL2H,split\nactual:1;1;0,1"; my $b3="\ntype:B3\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,SO61,SO52,split\ndualrealforms:compact,Sp21,split\nactual:2;2;2;0,1,2"; my $c3="\ntype:C3\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,Sp21,split\ndualrealforms:compact,SO61,SO52,split\nactual:3;3;0,1,2,3"; my $a4="\ntype:A4\ncovers:sc;ad\ninnerclass:s\nrealforms:split\ndualrealforms:compact,SU41,SU32\nactual:0,1,2\ntype:A4\ncovers:sc;ad\ninnerclass:c\nrealforms:compact,SU41,SU32\ndualrealforms:split\nactual:0;0;0"; my $b4="\ntype:B4\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,SO81,SO72,SO63,split\ndualrealforms:compact,Sp31,Sp22,split\nactual:3;3;3;3;0,1,2,3"; my $c4="\ntype:C4\ncovers:sc;ad\ninnerclass:s\nrealforms:compact,Sp31,Sp22,split\ndualrealforms:compact,SO81,SO72,SO63,split\nactual:4;4;4;0,1,2,3,4"; my $d4="\ntype:D4\ncovers:sc;ad;1/2,1/2[SO];0/2,1/2[other+];1/2,0/2[other-]\ninnerclass:s\nrealforms:compact,SO62,SO*8_1,SO*8_2,split\ndualrealforms:compact,SO62,SO*8_1,SO*8_2,split\n4;1,4;2,4;3,4;0,1,2,3,4\ntype:D4\ncovers:sc;ad;1/2,1/2[SO]\ninnerclass:u\nrealforms:SO71,SO53\ndualrealforms:SO71,SO53\nactual:1;0,1"; my $a2a2="\ntype:A2.A2\ncovers:sc;ad\ninnerclass:C\nrealforms:complex\ndualrealforms:complex\nactual:0"; my $b2b2="\ntype:B2.B2\ncovers:sc;ad\ninnerclass:C\nrealforms:complex\ndualrealforms:complex\nactual:0"; my $c2c2="\ntype:C2.C2\ncovers:sc;ad\ninnerclass:C\nrealforms:complex\ndualrealforms:complex\nactual:0"; my $f4="\ntype:F4\ncovers:sc\ninnerclass:c\nrealforms:compact,B4, split\ndualrealforms:compact,B4, split\nactual:2;2;0,1,2"; my $e6="\ntype:E6\ncovers:sc;ad\ninnerclass:s\nrealforms:F4,split\ndualrealforms:compact,T.D5,A1.A5\nactual:2;0,1,2;\ntype:E6\ncovers:sc;ad\ninnerclass:c\nrealforms:compact,T.D5,A1.A5\ndualrealforms:F4,split\nactual:1;1;0,1"; my $e7="\ntype:E7\ncovers:sc\ninnerclass:s\nrealforms:compact,T1.E6,A1.D6,split\ndualrealforms:compact,T1.E6,A1.D6,split\nactual:3;2,3;1,3;0,1,2,3"; my $e8="\ntype:E8\ncovers:sc\ninnerclass:s\nrealforms:compact,A1.E7,split\ndualrealforms:compact,A1.E7,split\nactual:2;1,2;0,1"; my $tiny=$a1; my $small=join "\n", $a1,$a2,$a1a1,$b2,$g2,$a3,$b3,$c3; my $medium=join "\n", $small,$a4,$b4,$c4,$d4,$a2a2,$b2b2,$c2c2,$f4,$e6,$e7; my $large=join "\n", $medium,$e8; if ($types =~ /^t/){ $types=$tiny; } elsif ($types =~ /^s/){ $types=$small; }elsif ($types =~ /^m/){ $types=$medium; }elsif ($types =~ /^l/){ $types=$large; } return $types; } sub help{ print " This program is used in testing the atlas software. It compares the output of atlas, over a list of commands, with a precomputed answer. It only compares MD5 checksums. It can also be used to just create atlas output files, without doing any testing. The program runs over a collection of predefined groups and auxiliary data. It creates a directory tree structure, and an input file for atlas. This file can be processed (separately or within this program) to populate the tree with atlas output files. Quick Start: Try this: testAtlas.pl -e -d tables -t tiny -o mysums -r referenceChecksums -l log This means: do everything (-e), only for type a1 (-t tiny), write checksums (-o mysums), compare result with reference (-r referenceChecksums), keep a log file (-l log). If that works, try the same with tiny replaced by t,s,m or l (tiny, small, medium or large) More Details: The program does four distinct things: 1) write an input file for atlas, based on the -t argument, and create a directory tree 2) process the input file using atlas. This populates the tree with data. 3) compute checksums on the resulting files in the directory tree. 4) compares these checksums with reference ones You can do each of these steps separately, or all using -e (everything). Usage: testAtlas.pl -m -d directory -t [t/s/m/l] [-l log] (make directories and input file for atlas) testAtlas.pl -a [-A atlasExecutable] (runs atlas with input file atlasInput) testAtlas.pl -c -d directory -o outputFile (compute checkums in files in directory, write to outputFile) testAtlas.pl -C -r referenceFile -s sumsFile (compare checksums in referenceFile and sumsFile testAtlas.pl -e -d directory -t [t/s/m/l] -o outputFile -r referenceFile -l log [-A atlasExecutable] The -m option can be used to create tables of atlas data, without doing any testing. (return for more or q to quit): "; my $ok=(); exit if $ok=~ /^q/; print " Options: -d: create directory tree under \"directory\" -t: use tiny/small/medium/large data input -o: write checksums to \"outputFile\" -r: compare checksum from referenceFile to \"outputFile\" -l: log file -q: quiet (less output to terminal, same amount to log file) -v: verbose (more output to terminal, same amount to log file) Here is more detail about each step: 1) writing input file for atlas and creating diretory tree: Based on -t [t/s/m/l], run over a list of groups, and create a directory tree, and an input file \"atlasInput\" for atlas. tiny: just A1 small: A1 through C3 medium: A1 through E7 large: A1 through E8, except for the principal (biggest) block 2) running atlas runs atlas using atlasInput for input: atlas < atlasInput You can give this command by hand. The default atlas program is given at the top of the file, you can change this with -A 3) Computing checksums Computes md5 checksums for every file in the tree and writes to outputFile 4) Comparing checksums Compares checksums in reference file ([-r] argument) and sums file ([-s] argument). In the case of [-e], the sums file is assumed to be the output file given by the [-o] argument The following are reported: a) any checksums which don't agree between the two files b) any files for which checksums are found in only one of the two files "; exit; } sub make{ print "making directories and input file for atlas\n"; print LOG "making directories and input file for atlas\n" if $logFile; unless ($directory){ print "You must include a directory with -d. See -h for a help file.\n"; exit; } unless ($types){ print "You must specify types with -t (t,s,m,l). See -h for a help file.\n"; exit; } if (-e $directory){ print " Target directory $directory exists. I am going to create some subdirectories of this (if they don't exist already).\n"; }else{ print " Target directory $directory doesn't exist. I am going to create it and some subdirectories.\n"; } print "Is this OK? [y/n]"; my $ok= (); chomp($ok); exit unless ($ok =~ /^y$|^yes$/); if ($force){ print "You have requested -f: overwrite existing files in the directory $directory. Is this OK? [y/n]"; my $ok= (); chomp($ok); exit unless ($ok =~ /^y$|^yes$/); } my $atlasInput='atlasInput'; my %innerClassNames=( 's' => 'splitInnerClass', 'c' => 'compactInnerClass', 'u' => 'unequalRankInnerClass', 'C' => 'complexInnerClass' ); if (-e $atlasInput){ system("mv $atlasInput $atlasInput.bak"); print "Moved $atlasInput to $atlasInput.bak\n" if $verbose; } my $date=localtime; open(OUT,">$atlasInput") or die("Can't open output file $atlasInput for output"); if ($logFile){ print "Writing log file $logFile\n"; print LOG "testAtlas.pl run at $date\n"; print LOG "types: $types\n"; print LOG "output written to $atlasInput\n\n"; } #type:A1 #covers:sc,ad #innerform:s #realforms:compact,split #dualrealforms:compact,split #actual:1;0,1 my ($type,@covers,%coversNames,$innerClass,@realForms,@dualRealForms,%actualDualRealForms); my @lines = split "\n", $types; foreach my $line (@lines){ chomp($line); # print "line:$line\n"; $line =~ s/\#.*$//; $line =~ s/ //g; # print "line:$line\n"; next unless $line; my ($cmd,$arg)=split ':', $line; $coversNames{'sc'}='simplyConnected'; $coversNames{'ad'}='adjoint'; # print "cmd:$cmd arg:$arg\n"; if ($cmd eq 'type'){ $type=$arg; print "Working on type $type\n" if $verbose; }elsif ($cmd eq 'covers'){ my @arg=split ';', $arg; foreach my $x (@arg){ if ($x =~ /sc|ad/){ push @covers, $x; }else{ my ($cover,$name)= ($x =~ /([^\[]*)\[([^\]]*)\]/); $coversNames{$cover}=$name; $name||die("Error: in $type $cover has no name\n"); } } }elsif ($cmd eq 'innerclass'){ $innerClass=$arg; }elsif ($cmd eq 'realforms'){ @realForms = split ',', $arg; }elsif ($cmd eq 'dualrealforms'){ @dualRealForms = split ',', $arg; }elsif ($cmd eq 'actual'){ my @actualDualRealForms = split ';', $arg; foreach my $i (0..$#actualDualRealForms){ my $dualRealForms=$actualDualRealForms[$i]; my @dualRealForms=split ',', $dualRealForms; $actualDualRealForms{$i}=\@dualRealForms; } } my $data=[$type,\@covers,\%coversNames,$innerClass,\@realForms,\@dualRealForms,\%actualDualRealForms]; if ($type and scalar(@covers) and $innerClass and scalar(@dualRealForms) and scalar(keys(%actualDualRealForms))){ &log($data) if $logFile; process($data); $type=''; @covers=(); $innerClass=''; @dualRealForms=(); %actualDualRealForms=();; } } print OUT "qq\n"; close(OUT); print "Wrote file atlasInput to be used as input to atlas\n"; print "You probably want to run the commannd\n\natlas < $atlasInput\n\n" unless $everything; } sub log{ my $data=shift; print LOG "type:$data->[0]\n"; print LOG "covers:", join ',', @{$data->[1]}; print LOG "\n"; print LOG "names of covers:\n"; my $names=$data->[2]; foreach my $cover (keys %$names){ print LOG " $cover: ", $names->{$cover},"\n"; } print LOG "inner class: $data->[3]\n"; print LOG "real forms: ", join ',', @{$data->[4]}; print LOG "\n"; print LOG "dual real forms: ", join ',', @{$data->[5]}; print LOG "\n"; print LOG "actual dual real forms:\n"; my $actual=$data->[6]; foreach my $realform (keys %$actual){ print LOG " $realform: ", join ',', @{$actual->{$realform}}; print LOG "\n"; } print LOG "\n"; } sub process{ my $data=shift; makeDirectories($data); makeAtlasInputFile($data); } sub makeDirectories{ my $data=shift; my ($type,$covers,$coversNames,$innerClass,$realForms,$dualRealForms,$actualDualRealForms)=@$data; print "Making directories for $type\n" if $verbose; mkdir $directory unless (-e $directory); makeDirectory($type); foreach my $cover (@$covers){ my $coverName=$coversNames->{$cover}||die("No \$coverName"); makeDirectory("$type/$coverName"); my $innerClassName=$innerClassNames{$innerClass}||die("No \$innerClassName"); makeDirectory("$type/$coverName/$innerClassName"); foreach my $i (0..$#{@$realForms}){ my $realFormName=$realForms->[$i]||die("No \$realFormName"); makeDirectory("$type/$coverName/$innerClassName/$realFormName"); foreach my $j (0..$#{@$dualRealForms}){ my $dualRealFormName=$dualRealForms->[$j]||die("No \$dualRealFormName"); makeDirectory("$type/$coverName/$innerClassName/$realFormName/dual$dualRealFormName"); } } } } sub done{ close LOG if $logFile; } sub makeDirectory{ my $dir=shift; chomp($dir); if (-e "$directory/$dir"){ $verbose and print " Directory $directory/$dir exists\n"; }else{ mkdir "$directory/$dir" or die("Can't make directory $directory/$dir"); $verbose and print " Making directory $directory/$dir\n"; } } sub makeAtlasInputFile{ my $data=shift; my ($type,$covers,$coversNames,$innerClass,$realForms,$dualRealForms,$actualDualRealForms)=@$data; print "Making atlas input file $outFile\n" if $verbose; foreach my $cover (@$covers){ my $coverName=$coversNames->{$cover}; my $innerClassName=$innerClassNames{$innerClass}; print OUT "type\n"; if ($cover =~ /sc|ad/){ print OUT "$type $cover $innerClass\n"; }else{ print OUT "$type\n$cover\n\n$innerClass\n"; } my $maindir="$directory/$type/$coverName"; # not yet in $innerClass # emit main mode commands (will overwrite if multiple inner classes) foreach my $command qw(roots coroots rootdatum){ my $file="$maindir/$command"; if ($force or !(-e $file)){ print OUT "$command\n"; print OUT "$file\n"; }else{ print "Skipping $command (file $file already exists and force is off)\n" if $verbose; } } # now move to real mode foreach my $i (0..$#{@$realForms}){ my $realForm=$realForms->[$i] or die("No \$realFormName"); my $realdir="$maindir/$innerClassName/$realForm"; print OUT "realform\n"; print OUT "$i\n" unless (scalar(@{$realForms})==1); # emit real mode commands foreach my $command qw(cartan kgb){ my $file="$realdir/$command"; if ($force or !(-e $file)){ print OUT "$command\n"; print OUT "$file\n"; }else{ print "Skipping $command (file $file already exists and force is off)\n" if $verbose; } } # finally move to block mode foreach my $j (@{$actualDualRealForms->{$i}}){ my $dualRealForm=$dualRealForms->[$j] or die("No \$dualRealFormName"); my $blockdir="$realdir/dual$dualRealForm"; my $file="$blockdir/smallblock"; # we use smallblock as mode entry, maybe trashing the output print OUT "smallblock\n"; print OUT "$j\n" unless (scalar(@{$actualDualRealForms->{$i}})==1); if ($force or !(-e $file)){ print OUT "$file\n"; }else{ print OUT "/dev/null\n"; } foreach my $command qw(block blocku klbasis kllist wcells wgraph) { my $file="$blockdir/$command"; if ($force or !(-e $file)){ print OUT "$command\n"; print OUT "$file\n"; }else{ print "Skipping $command (file $file already exists and force is off)\n" if $verbose; } } # leave block mode to forget dual real form print OUT "q\n"; } } } }