#!/usr/bin/perl

use strict;

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


use File::Find ();
use Env qw(RJ_HOME RJ_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 $rjrun;
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 $prog;
my $arg1;
my $arg2;
my $RJ_JAR;
# impossible since args can't start with blanks
my $CPinit = " I'm imPossible x5!234  ";
my $CPsaved = $CPinit;
my $CPoriginal;

use Getopt::Long;


# process command-line options.
my $help = 0;
my $pi = 0; # print header info
my $print = 0;
# quit on first test that gives unexpected result
my $qofu = 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.
my $cmpTool = 0; # use specified cmp tool

# be sure to update sub help() if update options.
GetOptions( 'h' => \$help,
            'v' => \$print,
            'i' => \$pi,
            'f' => \$qofu,
            's' => \$lcexitstatus,
            'd=s' => \$startDir,
            'x=s' => \@excludeDirs,
            'u' => \$u,
            'c=s' => \$cmpTool)
|| (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 RJ's RJV\n";

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

# Make sure directory that RJ_HOME refers to exists and is readable
if ( (-e $RJ_HOME) != 1 || (-r $RJ_HOME )!=1 ) {
    $! = 1;
    die "$0: environment variable RJ_HOME set to " .
        $RJ_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 \"".$RJ_HOME."/tools/bin/which.pl\"";
}
else {
	# UNIX or Cygwin
	$which = `which which`;
	chomp($which);
}

$cmpNoCR  = "perl \"".$RJ_HOME."/tools/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 \"".$RJ_HOME."/tools/bin/cmp.pl\"";
    }
    # we'll use these for both Windows and Linux
    # (even though we could use native Linux versions).
    $grep = "perl \"".$RJ_HOME."/tools/bin/grep.pl\"";
    $sort = "perl \"".$RJ_HOME."/tools/bin/sort.pl\"";
    $tail = "perl \"".$RJ_HOME."/tools/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 "\nrjv warning: using -u with Cygwin's Perl isn't a good idea;\n";
        print "  see comments in \$RJ_HOME/tools/cmds/cmpNoCR.\n\n";
    }
    $cmp  = "cmp";
    $grep = "grep";
    $sort = "sort";
    $tail = "tail";
}


# use special cmp?
if ($cmpTool) {
        $cmp  = $cmpTool;
}

$rjrun = "perl \"".$RJ_HOME."/tools/bin/rjrun\"";
$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 RJ_HOME, other env. vars., etc. and in other tools (../bin/*)
$javac = "\"".$javac."\"";
$java = "\"".$java."\"";

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

## Mostly for debugging purposes
$pi || print "RJ_HOME= $RJ_HOME\n";
$pi || print "RJRUN=   ".$rjrun."\n";
$pi || print "JAVAC=   ".$javac."\n";
$pi || print "JAVA=    ".$java."\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";

if ( !$pi ) {
    ## list RJ version number
    my $rjversion = "perl \"".$RJ_HOME."/tools/rjv/rjversion\"";
    system("$rjversion");
    if ( $? ) {
	die "$0: problem with rjversion ($rjversion)\n";
    }
}

##Set umask
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 RJ_JAR variable
$RJ_JAR  = setjarvar( "RJ", $RJ_HOME . "/source/rj.jar");
##########$JRX_JAR = setjarvar( "JRX", "/home/olsson/PKG/rjimpl/2.00603/source/jrx.jar");

##Print out our idea of OS.
## 2010-11-01 for non-Windows case,
## had been using $OSTYPE from the environment
## but that's an environment variable for csh, but a shell variable for bash.
## this is just for our info, so use Perl's idea of OS.
## (see also above code that sets OSsep and OSdelim.)
$pi || print "Operating System= ".$^O."\n";
$pi || !defined($OS) || print "  Windows \$OS= ".$OS."\n";

##Set CLASSPATH
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 RJ 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 . $RJ_JAR;

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

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

# remember directory in which rjv began
# so -d can use relative pathname, e.g., `rjv -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

my $quittesting = 0; # break out of this loop early?
foreach my $subd ( sort @subs ) {

    # change to where began rjv, 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";

    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 javac then run javac with args passed in
        if ( $verb =~ /^javac$/ ) {
            `$javac $args> Compiler.out 2>&1`;
            $result = $?>>8;
        }

        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 "rjrun") {
####	    my $tempargs = $args;
####	    $tempargs =~ s/\"/\\\\\\\"/g;
####		#print $tempargs."\n";
####	    `$rjrun $tempargs`;
	    `$rjrun $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 "rjrun.pl ". $prog .">".$ofile.".out\n";
                `$rjrun $prog >$ofile.out 2>&1`;
            }
            else {
                ( $ifile, $args ) = split /( |\n) /, $args, 2;
                $ifile =~ s/\n//;
                $ofile = $ifile;
				##print "rjrun.pl ". $prog ." <".$ifile.">".$ofile.".out\n";
                `$rjrun $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 > rjvcmp.out`;
		$result = $?>>8;
            }

        }


        elsif ( $verb =~ /^scmp$/ ) {
            # sorted file comparison
            ( $arg1, $arg2 ) = split / /, $args;
	    my $t1 = "rjvtemp1.out";
	    my $t2 = "rjvtemp2.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 = "rjvtemp1.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 = "rjvtemp2.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;
        }

	######### for now, just to make vsuite/quiescence/method/8 work
	elsif ( $verb eq "rj") {
	    ### print "rjv: **** using hardwired rj ********\n";
	    `rj $args`;
	}
        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 ( $qofu ) {
	    # could use label on outer loop and quit both here
	    # but instead quit inner, so it can do any clean up
	    $quittesting = 1;
        }

        if ( $verb eq "run" || $verb eq "CMP" ) {
            print " from rjrun <$ifile\n";
        }
        else {
            print " from $verb\n";
        }
        # previously broke loop only in else case above
        # makes more sense to always do it, yes?
        last; # quit this subdirectory on any error

    }
    close(SCRIPT) ||
        die "$0: cannot close $subd Script\n";

    if ( $quittesting ) {
	last;
    }

}

my $stopTime = time();
$pi || print "DATE= ".ctime()."\n";
$pi || printTimeDiff($stopTime-$startTime);

exit $exitstatus;


# display hours, minutes, seconds
# (assume number of days, weeks, etc. not interesting ;-)
sub printTimeDiff {
    my $diff = shift(@_);

    use constant SECONDS_PER_HOUR   => 3600;
    use constant SECONDS_PER_MINUTE =>   60;

    my $hDiff = int($diff / SECONDS_PER_HOUR); 
    $diff = $diff - $hDiff*SECONDS_PER_HOUR;

    my $mDiff = int($diff / SECONDS_PER_MINUTE);
    $diff = $diff - $mDiff*SECONDS_PER_MINUTE;

    # so diff is now number of seconds difference

    printf("Elapsed time (hh:mm:ss)= %02d:%02d:%02d\n", $hDiff, $mDiff, $diff);
}

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

    # 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 $RJ_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 \"$RJ_HOME/tools/bin/lst.pl\" -l \"$jar\"`;
    if ( $? ) {
    ##    die "$0: problem getting ls -l $RJ_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 "RJ.$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: rjv {option}

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

By default, rjv's start directory is \$RJ_HOME/vsuite.  However, the
start directory can be specified explicitly by the environment
variable RJ_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., rjv -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.
 
  -f       quit immediately after first test that differs from expected.
           (often used with -s and with ruf; see comments therein)
 
  -s       exitstatus.
           exit with the exitstatus of last command
           that differed from expected.
           (otherwise, rjv 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.

  -c P     use tool P instead of usual cmp.
           P is the absolute pathname to tool.
           P must implement cmp's -s option
             and must return exit statuses like cmp.
           overrides -u and rjv's default choice of cmp.
           mainly useful for development:  P can ignore debug output.

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

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