#!/usr/bin/perl
#----------------------------->  Perl - script  <-----------------------------#
#- Copyright (C) 199x by International Computer Science Institute            -#
#- This file is part of the GNU Sather package. It is free software; you may -#
#- redistribute  and/or modify it under the terms of the  GNU General Public -#
#- License (GPL)  as  published  by the  Free  Software  Foundation;  either -#
#- version 2 of the license, or (at your option) any later version.          -#
#- This  program  is distributed  in the  hope that it will  be  useful, but -#
#- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY -#
#- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        -#
#- The license text is also available from:  Free Software Foundation, Inc., -#
#- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     -#
#------------->  Please email comments to <bug-sather@gnu.org>  <-------------#

%prio = ( "QUICK",1,"STD",2,"EXT",3 );
$MAKE="pmake -s";
$ENV{'CLUSTERS'}=4;
delete $ENV{'START_GDB'};
delete $ENV{'DEBUG_PSATHER'};
delete $ENV{'DEBUG_AM'};

sub do_exec {
	local(@exec)=@_;
	local($x,$e);
	foreach $x (@exec) {
		print "$x 2>&1\n";
		open(COMP,"$x 2>&1 |");
		$e=<COMP>;
		if($e) {
			print $e;
			while(<COMP>) { print; }
			die "$dir/DESC: the following execution seems to have failed:\n$x\n";
		}
	}
}

sub compile {
	local($o,$e)=@_;
	local($n,$f);
	($n)= $o =~ /-o (\S+)/;
	if($n eq "") { $n="a.out"; }
	print "$cs $o 2>&1 $e\n";
	open(COMP,"$cs $o 2>&1 $e |");
	$f=0;
	readm: while(<COMP>) {
		/^\s+$/ && do { next readm; };
		/Call timed out/ && do { next readm; }; # ignore some pMake stuff
		/--- \S+ ---$/ && do { next readm; }; # ignore some pMake stuff
		$f=1;
		print;
	}
	close(COMP);
	$f==1 && die "$dir/DESC: the following compilation seems to have failed:\n$cs $o 2>&1 $e\n";
}

sub cleanup {
	local(@files)=@_;
	local($f,%files);
	foreach $f (@files) { $files{$f}=1; }
	$files{'.'}=1;
	$files{'..'}=1;
	$files{'DESC'}=1;
	$files{'CVS'}=1;
	opendir(DIR,".");
	foreach $f (readdir(DIR)) {
		if($files{$f}!=1) {
			if(-d $f) { system "rm -rf $f\n"; }
			else { system "rm -f $f\n"; }
		}
	}
}

sub exec_test {
	local($dir,$cs,$tprio,$psather)=@_;
	local($pwd,$name,$title,$prio,@options,@files,$type,@exec,$lang,@arch);
	local($o,$exec);

	$pwd=`pwd`;
	chop $pwd;
	$name="";
	$title="";
	$prio="STD";
	undef @options;
	undef @files;
	$type="STD";
	undef @exec;
	$lang="Sather";
	undef @arch;
	push(@files,"DESC");

	# read the descritpion file
	chdir($dir);
	open(DESC,"DESC") || die "cannot open $dir/DESC, $!";
	$l=0;
	readl:while(<DESC>) {
		$l++;
		chop;
		/^--/ && do { next readl; };  # comments
		/^\s*$/ && do { next readl; };  # empty lines
		/^name:/ && do { ($name)=/^name:\s*(\S+)/; next readl; };
		/^title:/ && do { ($title)=/^title:\s*(.+)$/; next readl; };
		/^prio:/ && do { ($prio)=/^prio:\s*(\w+)$/; next readl; };
		/^options:/ && do { ($o)=/^options:\s*(.+)$/; push(@options,$o); next readl; };
		/^files:/ && do { ($o)=/^files:\s*(.+)$/; @files=split(/\s+/,$o); next readl; };
		/^type:/ && do { ($type)=/^type:\s*(\w+)$/; next readl; };
		/^exec:/ && do { ($o)=/^exec:\s*(.+)$/; push(@exec,$o); next readl; };
		/^lang:/ && do { ($o)=/^lang:\s*(.+)$/; push(@lang,$o); next readl; };
		/^arch:/ && do { ($o)=/^arch:\s*(.+)$/; @arch=split(/\s+/,$o); next readl; };
		die "$dir/DESC:$l:syntax error in `$_'\n";
	}
	$type =~ /^(STD)|(ERROR)|(MULTIPLEX)$/ ||
	   die "$dir/DESC: type must be one of (STD ERROR MULTIPLEX), not $type\n";
	$prio =~ /^(STD)|(QUICK)|(EXT)$/ ||
	   die "$dir/DESC: prio must be one of (QUICK STD EXT), not $prio\n";
	if($prio{$prio}>$prio{$tprio}) { chdir $pwd; return; }
	if($lang eq "PSATHER" && $pasther!=1) { chdir $pwd; return; }
	$lang =~ /^(pSather)|(Sather)$/ ||
	   die "$dir/DESC: lang must be one of (Sather pSather), not $prio\n";
	foreach $o (@files) {
		if(! -e $o) { die "$dir/DESC: file `$o' does not exist\n"; }
	}
	foreach $o (@arch) {
		$o =~ /^(Solaris)|(Solaris-Myrinet)|(Solaris-TCP)|(Meiko)|(LWP)$/ ||
		   die "$dir/DESC: architecture $o is not known. Should be one of (Solaris Solaris-Myrinet Solaris-TCP Meiko LWP).\n";
	}
	$type eq 'ERROR' && @exec!=1 && @exec!=@options && die "$dir/DESC: type==ERROR implies that there is one exec line or as many exec lines as options\n";
	@options ==0 && die "$dir/DESC: you did not specify any options\n";
	@exec ==0 && die "$dir/DESC: you did not specify any exec function\n";

	print '=' x 78,"\n";
	print "$name: $title\n";
	print '-' x 78,"\n";
	# Run the compiler
	local($i);
	if($type eq "ERROR") {
		for($i=0;$i<@options;$i++) {
			if(@exec==1) { $e=$exec[0]; }
			else { $e=$exec[$i]; }
			&compile($options[$i],"| $e 2>&1"); 
		}
	} else {
		local($n,$e)=("");
		foreach $o (@options) {
			&compile($o,"");
			$type eq 'MULTIPLEX' && &do_exec(@exec);
		}
		$type eq 'STD' &&  &do_exec(@exec);
	}
	&cleanup(@files);
	print "TEST SUCCESSFUL\n";
	chdir $pwd;
	return 1;
}

1;
