#! /usr/bin/perl -w

use POSIX;
use Text::Diff;

$verbose = 0;
($GRADES_DIR = $0) =~ s#/[^/]+$##;
-d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";

-d ("output") || mkdir ("output") or die "output: mkdir: $!\n";

if (! -d "pintos") {
    my (@tarballs)
	= grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
		glob ("*.tar.gz"));
    die "no pintos dir and no source tarball\n" if scalar (@tarballs) == 0;
    die "no pintos dir and multiple tarballs\n" if scalar (@tarballs) > 1;
    mkdir "pintos" or die "pintos: mkdir: $!\n";
    mkdir "pintos/src" or die "pintos: mkdir: $!\n";
    print "Extracting $tarballs[0]...\n";
    xsystem ("", "cd pintos/src && tar xzf ../../$tarballs[0]")
	or die "extraction failed\n";
}
-d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";

print "Compiling initial tree...\n";
xsystem ("make", "cd pintos/src/threads && make") or die;

for my $test ("alarm-single", "alarm-multiple", "alarm-zero", "alarm-negative",
	      "join-simple"
	      #"join-quick", "join-multiple", "join-nested",
	      #"join-dummy", "join-invalid", "join-no",
	      #"priority-preempt", "priority-fifo", "priority-donate-one",
	      #"priority-donate-multiple", "priority-donate-nest",
	      #"mlfqs"
	      ) {
    print "Testing $test: ";
    my ($result) = run_test ($test);
    print "$result\n";

    if ($result eq 'ok') {
	print "Grading $test: ";
	$result = grade_test ($test);
	print "$result\n";
    }
}

sub grade_test {
    my ($test) = @_;

    my (@output) = snarf ("output/$test.run.out");
    
    ($grade_func = $test) =~ s/-/_/g;
    eval "grade_$grade_func(\@output)";
    if ($@) {
	die $@ if $@ =~ /at \S+ line \d+$/;
	return $@;
    }
    return "ok";
}

sub grade_alarm_single {
    verify_alarm (1, @_);
}

sub grade_alarm_multiple {
    verify_alarm (7, @_);
}

sub grade_alarm_zero {
    my (@output) = @_;
    #verify_common (@output);
    die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
}

sub grade_alarm_negative {
    my (@output) = @_;
    #verify_common (@output);
    die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
}

sub grade_join_simple {
    my (@output) = @_;
    #verify_common (@output);
    compare_output ("$GRADES_DIR/join-simple.exp", @output);
}

sub compare_output {
    my ($exp_file, @actual) = @_;
    my (@expected) = snarf ($exp_file);

    # Trim header and trailer from @actual.
    while (scalar (@actual) && $actual[0] ne $expected[0]) {
	shift (@actual);
    }
    die "First line of expected output was not present.\n" if !@actual;
    while (scalar (@actual) && $actual[$#actual] ne $expected[$#expected]) {
	pop (@actual);
    }
    die "Final line of expected output was not present.\n" if !@actual;
    
    # Check whether they're the same.
    if ($#actual == $#expected) {
	my ($eq) = 1;
	for (my ($i) = 0; $i <= $#expected; $i++) {
	    $eq = 0 if $actual[$i] ne $expected[$i];
	}
	return if $eq;
    }

    # They differ.  Output a diff.
    my (@diff) = split ("\n", diff (\@expected, \@actual, {CONTEXT => 0}));
    for (my ($i) = 0; $i < $#diff; ) {
	if ($diff[$i] =~ /^@@/) {
	    if ($i == 0) {
		shift (@diff);
	    } else {
		$diff[$i++] = "";
	    }
	} else {
	    $i++;
	}
    }
    my ($diff) = join ("\n", @diff);
    die "Output differs from expected:\n$diff\n";
}

sub verify_alarm {
    my ($iterations, @output) = @_;

    #verify_common (@output);

    my (@products);
    for (my ($i) = 0; $i < $iterations; $i++) {
	for (my ($t) = 0; $t < 5; $t++) {
	    push (@products, ($i + 1) * ($t + 1) * 10);
	}
    }
    @products = sort {$a <=> $b} @products;

    for $_ (@output) {
	die $_ if /Out of order/;

	my ($p) = /product=(\d+)$/;
	next if !defined $p;

	my ($q) = shift (@products);
	die "Too many wakeups.\n" if !defined $q;
	die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
    }
    die scalar (@products) . " fewer wakeups than expected.\n"
	if @products != 0;
}

sub run_test {
    my ($test) = @_;
    return "ok" if -f "output/$test.run.out";
    
    my ($src) = "$GRADES_DIR/$test.c";
    -e $src or die "$src: stat: $!\n";
    xsystem ("", "cp $src pintos/src/threads/test.c") or die;
    unlink ("pintos/src/threads/build/threads/test.o");
    unlink ("pintos/src/threads/build/kernel.o");
    unlink ("pintos/src/threads/build/kernel.bin");
    unlink ("pintos/src/threads/build/os.dsk");
    xsystem ("$test.make", "cd pintos/src/threads && make")
	or return "compile error";
    xsystem ("$test.run", "cd pintos/src/threads/build && pintos -v run -q")
	or return "Bochs error";
    return "ok";
}

sub xsystem {
    my ($log, $command) = @_;
    print "$command\n" if $verbose;

    my ($status);
    if ($log ne '') {
	$status = systimeout ("($command) >output/$log.out 2>output/$log.err");
	unlink ("output/$log.err") unless $status != 0;
    } else {
	$status = systimeout ($command);
    }

    die "Interrupted\n"
	if WIFSIGNALED ($status) && WTERMSIG ($status) == SIGINT;

    return $status == 0;
}

sub systimeout {
    my ($command) = @_;
    my ($status);
    eval {
	local $SIG{ALRM} = sub { die "alarm\n" };
	alarm 10;
	$status = system ($command);
	alarm 0;
    };
    if ($@) {
	die unless $@ eq "alarm\n";   # propagate unexpected errors
	print "Timed out.\n";
	$status = -1;
    }
    return $status;
}

sub snarf {
    my ($file) = @_;
    open (OUTPUT, $file) or die "$file: open: $!\n";
    my (@lines) = <OUTPUT>;
    close (OUTPUT);
    return @lines;
}