#!/usr/bin/perl

use strict;

# to see command-line options, type "jrv -h".


use File::Find ();
use Env qw(JR_HOME JR_ECHO JR_VSUITEDIR CLASSPATH OS OSTYPE);

my $OSdelim;
my $OSsep;
# set $OSdelim and $OSsep based on what Java we're using,
# i.e., what Java expects in CLASSPATH.
# (this works for Cygwin assuming Java installed within Windows, not Cygwin)
if(defined($OS) && $OS =~ /Windows/) {
    $OSdelim = ";";
    $OSsep = "\\";
}
else {
    $OSdelim = ":";
    $OSsep = "/";
}

my $OSopen;  # how environment variables are denoted (start delimiter)
my $OSclose; # (end delimiter)
# set $OSopen and $OSclose based on what $OS we're running
# and what Perl we're using.
# Perl installed under Cygwin needs UNIX-style
# since they are used on command line with Cygwin.
# Perl installed under Windows needs Windows-style.
my $archname;
$archname = `perl -V:archname`;
if(defined($OS) && $OS =~ /Windows/ && $archname !~ /cygwin/) {
    $OSopen = "%";
    $OSclose = "%";
}
else {
    $OSopen = "\$";
    $OSclose = "";
}

use Sys::Hostname;
use Cwd;
use File::Path; # for mkpath and rmtree

my $jrc;
my $jrrun;
my $javac;
my $java;
my $which;
my $cmp;
my $cmpNoCR;
my $sort;
my $grep;
my $tail;
my $host;
my $result;
my $testcase;
my $verb;
my $args;
my $out;
my $rest;
my $code;
my $ofile;
my $ifile;
my @subs;
my $line;
my $ccr2jr;
my $csp2jr;
my $m2jr;
my $prog;
my $arg1;
my $arg2;
my $JRT_JAR;
my $JRX_JAR;
# impossible since args can't start with blanks
my $CPinit = " I'm imPossible x5!234  ";
my $CPsaved = $CPinit;
my $CPoriginal;
my $ECHOset = 0;
my $ECHOinit = " I'm imPossible 543!x9  ";
my $ECHOsaved = $ECHOinit;

use Getopt::Long;


# process command-line options.
my $help = 0;
my $pi = 0; # print header info
my $print = 0;
# exit with the exitstatus of last command that differed from expected.
# (used typically when testing just one program repeatedly until it fails.)
my $lcexitstatus = 0;
my $exitstatus = 0; # exitstatus
my $startDir = 0;
my @excludeDirs;
my $u = 0; # use standard UNIX tools for grep, etc.

# be sure to update sub help() if update options.
GetOptions( 'h' => \$help,
            'v' => \$print,
            'i' => \$pi,
            's' => \$lcexitstatus,
            'd=s' => \$startDir,
            'x=s' => \@excludeDirs,
            'u' => \$u)
|| (help() && die "$0: problem processing command line options\n");

if ($help) {
    help();
    exit 0; # some tools exit with 1 in such cases
}

# would be nice to add "-j jarfile" option
# to facilitate testing of new versions of JR.
# however, the tools that jrv calls (e.g., jrc) set jar file too,
# not that simple.


# only directories named on command line (no -v, -d, -x args)
my @dirs = @ARGV;


$pi || print "\nStarting JRV\n";

# Check to see if JR_HOME has been defined
if ( !$JR_HOME ) {
    $! = 1;
    die "$0 requires environment variable JR_HOME\n" .
        "to be set to the absolute pathname of JR's home\n";
}

# Make sure directory that JR_HOME refers to exists and is readable
if ( (-e $JR_HOME) != 1 || (-r $JR_HOME )!=1 ) {
    $! = 1;
    die "$0: environment variable JR_HOME set to " .
        $JR_HOME .
        "\nbut that directory does not exist or is not readable\n";
}

# Get the programs we will be calling.

if(defined($OS) && $OS =~ /Windows/ && !($archname =~ /cygwin/)) {
	# pure Windows
	$which = "perl \"".$JR_HOME."/bin/which.pl\"";
}
else {
	# UNIX or Cygwin
	$which = `which which`;
	chomp($which);
}

$cmpNoCR  = "perl \"".$JR_HOME."/bin/cmpNoCR.pl\"";

if (! $u) {
    # use special cmp for Cygwin with Perl installed under Cygwin
    if(defined($OS) && $OS =~ /Windows/ && $archname =~ /cygwin/) {
        $cmp  = $cmpNoCR;
    }
    else {
        $cmp  = "perl \"".$JR_HOME."/bin/cmp.pl\"";
    }
    # we'll use these for both Windows and Linux
    # (even though we could use native Linux versions).
    $grep = "perl \"".$JR_HOME."/bin/grep.pl\"";
    $sort = "perl \"".$JR_HOME."/bin/sort.pl\"";
    $tail = "perl \"".$JR_HOME."/bin/tail.pl\"";
}
else {
    # use standard UNIX tools.
    # this is useful to verify that our versions (above)
    # do the same as the standard UNIX and that the Script
    # files don't require anything whose behavior differs
    # between the two sets of tools.
    # (arguably, these should be environment variables...)
    if(defined($OS) && $OS =~ /Windows/ && $archname =~ /cygwin/) {
        print "\njrv warning: using -u with Cygwin's Perl isn't a good idea;\n";
        print "  see comments in \$JR_HOME/cmds/cmpNoCR.\n\n";
    }
    $cmp  = "cmp";
    $grep = "grep";
    $sort = "sort";
    $tail = "tail";
}

$jrc = "perl \"".$JR_HOME."/bin/jrc\"";
$jrrun = "perl \"".$JR_HOME."/bin/jrrun\"";
$javac = `$which javac`;
chomp($javac);
$java = `$which java`;
chomp($java);
#### 2003-08-15 below fixes Windows for Aaron (and works on UNIX too),
#### but need to consider this problem in general,
#### e.g., for JR_HOME, other env. vars., etc. and in other tools (../bin/*)
$javac = "\"".$javac."\"";
$java = "\"".$java."\"";

$ccr2jr = "perl \"".$JR_HOME."/bin/ccr2jr\"";
$csp2jr = "perl \"".$JR_HOME."/bin/csp2jr\"";
$m2jr = "perl \"".$JR_HOME."/bin/m2jr\"";

# set startDir, in order:
#   command-line option (already set above), environment variable, default.
if(!$startDir) {
    if(defined($JR_VSUITEDIR)) {
        $startDir = $JR_VSUITEDIR;
    }
    else {
	$startDir = $JR_HOME."/vsuite";
    }
}

## Mostly for debugging purposes
$pi || print "JR_HOME= $JR_HOME\n";
$pi || print "JRC=     ".$jrc."\n";
$pi || print "JRRUN=   ".$jrrun."\n";
$pi || print "JAVAC=   ".$javac."\n";
$pi || print "JAVA=    ".$java."\n";
$pi || print "ccr2jr=  ".$ccr2jr."\n";
$pi || print "csp2jr=  ".$csp2jr."\n";
$pi || print "m2jr=    ".$m2jr."\n";
$pi || print "WHICH=   ".$which."\n";
$pi || print "CMP=     ".$cmp."\n";
$pi || print "GREP=    ".$grep."\n";
$pi || print "SORT=    ".$sort."\n";
$pi || print "TAIL=    ".$tail."\n";

## list JR version number
$pi || system("$jrc -version");
if ( $? ) {
    die "$0: problem getting version from $jrc\n";
}

##$pi || system("$jrrun -version");
##if ( $? ) {
##    die "$0: problem getting version from $jrrun\n";
##}
## above is old code, but wanted to line up jrc and jrrun version info, so:
if (!$pi) {
    my $v = `$jrrun -version`;
    if ( $? ) {
        die "$0: problem getting version from $jrrun\n";
    }
    $v =~ s/version/     version/;
    print "$v";
}

##Set usmak
umask(0002);

##Get hostname
$host = hostname();

##Check to make sure a hostname was found
if ( !$host ) {
    $! = 1;
    die "Can't figure out hostname\n";
}

##Print some information for the user
$pi || print "HOST= $host\n";
$pi || print "Start Directory= ".$startDir."\n";

##Set the JRT_JAR and JRX_JAR variables
$JRT_JAR = setjarvar( "JRT", "jrt.jar");
$JRX_JAR = setjarvar( "JRX", "jrx.jar");

##Set CLASSPATH and chdir to the vsuite
##Because Windows and Unix uses a different separator for the classpath
##the OS is checked to see what type it is and sets the separator based on
##that. The OS is also printed out.
if($OS =~ /Windows/) {
	$pi || print "Operating System= ".$OS."\n";
}
else {
	$pi || print "Operating System= ".$OSTYPE."\n";
}

if(defined($CLASSPATH)) {
    $pi || print "original CLASSPATH= ".$CLASSPATH."\n";
    $CPoriginal = $CLASSPATH;
}
else {
    $CPoriginal = "";
    warn "\n$0: environment variable CLASSPATH not set;\n";
    warn "    multi-VM JR programs likely won't work\n\n";
    # they could work if, e.g., CLASSPATH set in .cshrc but not in shell
    # that's running jrv.
}

####$CLASSPATH = "." . $OSdelim . $JR_JAR;
$CLASSPATH = "." . $OSdelim . $JRT_JAR
                 . $OSdelim . $JRX_JAR;

$pi || print "jrv sets CLASSPATH= ".$CLASSPATH."\n";

use Time::localtime;
$pi || print "DATE= ".ctime()."\n";

# remember directory in which jrv began
# so -d can use relative pathname, e.g., `jrv -d .'
my $here = cwd;

mustchdir($startDir);

##Find all the Script files full path names in the directories passed in from
##the command line. If no arguments were passed in then search
##the entire vsuite

use vars qw/*name *dir *prune/;
*name  = *File::Find::name;
*dir   = *File::Find::dir;
*prune = *File::Find::prune;

if (@dirs) {
    File::Find::find( { wanted => \&wanted }, @dirs );
}
else {
    File::Find::find( { wanted => \&wanted }, '.' );
}

########################################## what's \z/s mean????????????????????
sub wanted {
    if (/^Script$/) {
        my $subdir = $name;
        $subdir =~ s/\/Script$//;
##print "$name $subdir\n";
	push @subs, $subdir;
    }
}

##print "@subs\n";
##exit;

## This main loop. Each iteration will run one of the Script files

foreach my $subd ( sort @subs ) {

    # change to where began jrv, so relative pathnames work with -d option.
    # (don't combine with next cd so that absolute pathnames work too.)
####my $zz = cwd;
####print "pwd=$zz\n";
####print "here=$here\n";
    mustchdir($here);

    my $temp1 = $subd;
    # drop any leading ./ on pathname
    $temp1 =~ s/^\.\///;

    my $skip = 0;
    # is this one of the excluded directories?
    foreach my $i ( @excludeDirs ) {
	# see whether this subd has $i as a pathname prefix
	# would be smarter to compute @x once ...
        my @x = split( '/', $i );
        my @s = split( '/', $temp1 );
## print "$#x and $#s\n";
	if ($#x <= $#s) {
	    $skip = 1;
	    for (my $k = 0; $k <= $#x; $k++) {
		if(@x[$k] ne $s[$k] ) {
		    $skip = 0;
		    last;
		}
	    }
	}
	if( $skip == 1 ){
	    last;
	}
    }
    if( $skip == 1 ){
	next;
    }

####print "subd=$subd\n";
    mustchdir($startDir."/".$subd);
    print $subd. ":\n";

    ## Open up the script file
    open(SCRIPT, "Script") ||
        die "$0: cannot open $subd Script\n";

    # 2006-08-03
    # removing jrGen before Script run is a good idea.
    # (and it's consistent with jrgo's behavior.)
    # most of the time, jrGen won't be there,
    # but in rare cases, it can be there.
    # if so, it might contain some .java files from a previous compilation
    # that might not be rewritten (e.g., from a different version of the
    # compiler that generates files with different names).
    # then get weird errors.
    # so, better safe than sorry...
    rmtree("jrGen", 0, 1);

    my $disablerm = 0; # keep intermediate files around on some errors
    ## This while loop iterates through each line of the Script file
    ## and executes the commands
    while ( $line = <SCRIPT> ) {

	  ## If the line is a comment then move on
        if ( $line =~ /^\s*#/ ) {
            next;
        }


        # handle any continuation lines (\ as last character)
	# by making them all one big line.
        # (handle comments above so don't
        # treat \ within comment as continuation.)
        while ($line =~ s/\\$//) {
	    chop($line);
            $line = $line . <SCRIPT>;
        }

	  ## If the line is all whitespace or a comment then move on
          ## (tested above for a comment, but can have blank line
          ## continue into a comment; weird, but OK I guess.)
        if ( $line =~ /^\s*$/ ||  $line =~ /^\s*#/ ) {
            next;
        }
	  ## Parse the line
        ( $code, $verb, $args ) = split / /, $line, 3;
        chop($args);

	if( $print == 1) {
	    print $line;
	}

	if($OS =~ /Windows/) {
	   $args =~ s/\/dev\/null/NUL/g;
	}

	  ## If jrc then run jrc with the args
        if ( $verb =~ /^jrc$/ ) {
           `$jrc $args > Translator.out 2>&1`;
	   $result = $?>>8;
        }

	  ## If javac then run javac with args passed in
        elsif ( $verb =~ /^javac$/ ) {
            `$javac $args> Compiler.out 2>&1`;
            $result = $?>>8;
        }

	  ## If jr_rmic then run jr_rmic with the args
        elsif ( $verb =~ /^jr_rmic$/ ) {
	    print "   warning: jrv Script contains jr_rmic command, which is no longer used -- ignored\n";
	   $result = 0;
        }

        elsif ( $verb =~ /^ccr2jr$/ ) {
            `$ccr2jr $args>CCR.out 2>&1`;
        }

        elsif ( $verb =~ /^m2jr$/ ) {
            `$m2jr $args>M.out 2>&1`;
        }

        elsif ( $verb =~ /^csp2jr$/ ) {
            `$csp2jr $args>CSP.out 2>&1`;
        }

        elsif ( $verb =~ /^rm$/ ) {
            if (! $disablerm) { # only if not disabled
		my $tempargs = $args;
		# remove -rf artifact.
		# (Perl v5.6.0 needs \s otherwise " " is first value in loop.)
		# (doesn't hurt in v5.8.0)
		$tempargs =~ s/-rf\s//g;
		while ( <${tempargs}> ) {
		    # print "$_\n";
#		    rmtree($_,0,1);
# 2003-09-22
# 3rd param 0 or 1 doesn't seem to matter with deleting mypkg.jar problem
# on Windows.
		    rmtree($_,0,0);
	        }
		$? = 0; # above rm always works?
	    }
	    else {
		# pretend rm worked as expected (to prevent later message)
		$? = $code << 8;
	    }
        }

	elsif ( $verb =~ /^cmp$/ ) {
	    `$cmp -s $args 2>&1`;
	}

	elsif ( $verb =~ /^cmpNoCR$/ ) {
	    `$cmpNoCR -s $args 2>&1`;
	}

	elsif ( $verb =~ /^grep$/ ) {
	    `$grep $args 2>&1`;
	}

	elsif ( $verb =~ /^tail$/ ) {
	    `$tail $args`;
	}

	  ## if cd then call chdir to the given directory
        elsif ( $verb =~ /^cd$/ ) {
            mustchdir($args);
	    $? = 0; # mustchdir succeeded
        }

	elsif ( $verb eq "jrrun") {
####	    my $tempargs = $args;
####	    $tempargs =~ s/\"/\\\\\\\"/g;
####		#print $tempargs."\n";
####	    `$jrrun $tempargs`;
	    `$jrrun $args`;
	}

	  ## if run then set up correct output files
	  ## Slight modfied so that if no output is sent in
	  ## then it wont try to call the input file dev/null
	elsif ( $verb =~ /^run$/ ) {

            if ( !$args ) {
                print "$0 No program specified to run";
            }
            else {
                ( $prog, $args ) = split / /, $args;
                $prog =~ s/\n//;
            }

            if ( !$args ) {
                $ifile = "null";
                $ofile = "No_input";
				##print "jrrun.pl ". $prog .">".$ofile.".out\n";
                `$jrrun $prog >$ofile.out 2>&1`;
            }
            else {
                ( $ifile, $args ) = split /( |\n) /, $args, 2;
                $ifile =~ s/\n//;
                $ofile = $ifile;
				##print "jrrun.pl ". $prog ." <".$ifile.">".$ofile.".out\n";
                `$jrrun $prog <$ifile>$ofile.out 2>&1`;
            }
		## Get result of run
	    #print $result."\n"; # Used for debugging
            $result = $?>>8;
		
		## If result is valid then run cmp on the output file
            if ( $result == $code ) {
                $verb = "CMP";
                $code = 0;
                `$cmp -s $ofile.std $ofile.out > jrvcmp.out`;
		$result = $?>>8;
            }

        }


        elsif ( $verb =~ /^scmp$/ ) {
            # sorted file comparison
            ( $arg1, $arg2 ) = split / /, $args;
	    my $t1 = "jrvtemp1.out";
	    my $t2 = "jrvtemp2.out";
            `$sort $arg1 > $t1`;
            `$sort $arg2 > $t2`;
            `$cmp -s $t1 $t2`;
	    $result = $?;
            rmtree(["$t1","$t2"],0,1);
	    $? = $result; # want result from cmp, not rm so below code works.
        }

        elsif ( $verb =~ /^ndcmp$/ ) {

            # nondeterministic file comparison:
            # succeeds if match one of given standard files.
            # order of args is name of generated file followed by
            # all standard files; makes code simpler.

	    ## code for this is just simplified ndscmp code from below,
	    ## but we currently don't use this, 
	    ## so we'll just make it an error for now......
	    $! = 1;
	    die "$0: ndcmp not currently implemented\n";
        }

        elsif ( $verb =~ /^ndscmp$/ ) {
                # nondeterministic sorted file comparison:
                # succeeds if after sorting match one of given standard files.
                # order of args is name of generated file followed by
                # all standard files; makes code simpler.
                # (unfortunately, scmp isn't a separate script,
                # so we repeat its code here.)
############# should make scmp a subroutine #############################
	    my $out;
	    my $rest;
            ( $out, $rest ) = split / /, $args;
	    my $t1 = "jrvtemp1.out";
            `$sort $out > $t1`;
            if ( $rest eq "" ) {
                $result = 1;
            }
            else {
		# use foreach so that get wildcard expansion
		# e.g., if $rest is "ti.std*"
		# also works if $rest is "ti.std1 ti.std2".
		my @r = split(/ /,$rest);
                foreach my $current ( <@r> ) {
		    my $t2 = "jrvtemp2.out";
                    `$sort $current > $t2`;
                    `$cmp -s $t1 $t2`;
                    $result = $? >> 8;
                    rmtree("$t2",0,1);
                    if ( $result == 0 ) {
                        last;
                    }
                }
            }
	    rmtree("$t1",0,1);
            $? = $result;
        }

        elsif ( $verb =~ /^CPuseoriginal$/ ) {
            # use original classpath.
	    # sequence should be: CPuseoriginal, ..., CPrestore
	    $CPsaved = $CLASSPATH;
	    $CLASSPATH = $CPoriginal;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPprepend$/ ) {
            # prepend to classpath.
	    # sequence should be: CPprepend, ..., CPrestore
	    $CPsaved = $CLASSPATH;
	    $CLASSPATH = "$args" . $OSdelim . $CLASSPATH;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPrestore$/ ) {
            # restore classpath
	    $CPsaved ne $CPinit ||
		die "$0: error in Script: " .
		    "CPrestore before corresponding CPprepend\n";
	    $CLASSPATH = $CPsaved;
	    $CPsaved = $CPinit;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPjavac$/ ) {
	    # CPjavac X Y
	    # X becomes front of classpath option; Y are .java files.
	    # so above is mapped to:
	    # UNIX:    javac -classpath X:$CLASSPATH  Y
	    # Windows: javac -classpath X;%CLASSPATH% Y
	    # (Cygwin: one of above)
	    my $cparg;
	    my $rest;
	    ($cparg, $rest) = split / /, $args, 2;
	    $cparg = $cparg . $OSdelim . $OSopen . "CLASSPATH" . $OSclose;
            `$javac -classpath \"$cparg\" $rest > Compiler.out 2>&1`;
            $result = $?>>8;
        }

        else {
            `$verb $args`;
        }

        $result   = $?>>8;
        $testcase = $verb . $result;
####print $testcase."\n";
        if (   $testcase eq $verb . $code )
        {
            next;
        }
        if (   $lcexitstatus ) {
	    # alternatively (but is that needed or useful?):
	    # 
	    #   $exitstatus = ($code == 0)?$result:$code;
            $exitstatus = 1;
        }
	$disablerm = 1;
        if ( $testcase eq "CMP1" ) {
            print "    output differs";
        }
        elsif ( $testcase eq "CMP2" ) {
            print "    missing $ofile.std to compare output";
        }
        else {
            print "    expected $code, got $result";
        }

        if ( $verb eq "run" || $verb eq "CMP" ) {
            print " from jrrun <$ifile\n";
        }
        else {
            print " from $verb\n";
	    last; # quit this subdirectory on other error
        }
    }
    close(SCRIPT) ||
        die "$0: cannot close $subd Script\n";


}

$pi || print "DATE= ".ctime()."\n";

exit $exitstatus;


sub setjarvar {
    my $m = shift(@_); # message
    my $f = shift(@_); # jar file

    my $jar = $JR_HOME . "/classes/" . $f;
    # special case for Perl within Cygwin
    # since Java needs Windows-style CLASSPATH.
    # code after this if should work fine since Cygwin
    # allows both kinds of names.
    if(defined($OS) && $OS =~ /Windows/ && $archname =~ /cygwin/) {
	# 2007-10-20 quotes needed on $jar since it might contain spaces.
        $jar  = `cygpath -w "$jar"`;
	chomp($jar);
    }

    ##Make sure that the file $jar points to is accessible
    if ( (-e $jar) !=1 || (-r $JR_HOME) != 1 ) {
	$! = 1;
	die "$0: $m jar file set to " .
	    $jar .
	    "\nbut that file does not exist or is not readable\n";
    }

    # Thu Aug 15 16:01:56 PDT 2002.  On CSIF, where perl -v shows:
    #    This is perl, v5.6.0 built for i386-linux
    #
    # warns about (... is pathname to lst.pl)
    #
    #     Name "main::opt_m" used only once: possible typo at ...
    #     Name "main::opt_r" used only once: possible typo at ...
    #     Can't call method "name" on an undefined value at ...
    #
    # so, we'll make that non-critical.

    my $lsout = `perl \"$JR_HOME/bin/lst.pl\" -l \"$jar\"`;
    if ( $? ) {
    ##    die "$0: problem getting ls -l $JR_JAR from lst.pl\n";
        warn "$0: problem getting ls -l $jar from lst.pl\n";
    }
    else {
	chomp($lsout);
	my @lsfields = split( ' ', $lsout );
	# note: hardwired dependent on output of above command.
	$pi ||  print "JR.$m = $jar $lsfields[11]\n";
	$lsout =~ s/$lsfields[11]$//;
	$pi || print "  $lsout\n";
    }
    return $jar;
}

sub mustchdir {
    my $dir = shift;
    if ( ! (chdir $dir) ) {
        $! = 1;
        die "$0: cannot chdir $dir\n";
    }
}

sub help {
    print <<END;
usage: jrv {option}

jrv tests in the `start directory' and all subdirectories below it.

By default, jrv's start directory is \$JR_HOME/vsuite.  However, the
start directory can be specified explicitly by the environment
variable JR_VSUITEDIR or the -d command-line option (see below).  (If
both are specified, the -d option is used.)


command-line options (which can appear in any order and can be repeated):

  D        test subdirectory D test relative to the start directory.
           (don't test entire start directory)
 
  -d D     change the start directory to D.
           e.g., jrv -d .
           changes the start directory to the current directory.
 
  -x D     exclude from testing directory D (relative to the start directory).
 
  -i       don't print header (and trailer) information.
       
  -v       verbose.
           print each command from the Script file before executing it.
 
  -s       exitstatus.
           exit with the exitstatus of last command
           that differed from expected.
           (otherwise, jrv would exit normally, since it had no problems.)
           (used typically when testing just one program repeatedly
            until it fails; see ruf and comments therein)
 
  -u       use standard UNIX tools.
           instead of using our Perl versions of grep, cmp, etc.,
           use the corresponding standard UNIX tools.
           mainly useful for checking that our tools work properly.

  -h       print this help message (and then exit).
 
END

    return 1; # any "true" value will work
}
