#! /usr/bin/perl

# Find the directory that contains the grading files.
our ($GRADES_DIR);

# Add our Perl library directory to the include path. 
BEGIN {
    ($GRADES_DIR = $0) =~ s#/[^/]+$##;
    -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
    unshift @INC, "$GRADES_DIR/../lib";
}

use warnings;
use strict;
use Pintos::Grading;

our ($hw) = "userprog";
our (@TESTS);		# Tests to run.
our ($test);
our (%extra);
our ($action);

parse_cmd_line qw (args-argc args-argv0 args-argvn args-single args-multiple
		   args-dbl-space
		   sc-bad-sp sc-bad-arg sc-boundary
		   halt exit
		   create-normal create-empty create-null create-bad-ptr 
		   create-long create-exists create-bound
		   open-normal open-missing open-boundary open-empty open-null
		   open-bad-ptr open-twice
		   close-normal close-twice close-stdin close-stdout
		   close-bad-fd
		   read-normal read-bad-ptr read-boundary read-zero read-stdout
		   read-bad-fd
		   write-normal write-bad-ptr write-boundary write-zero
		   write-stdin write-bad-fd
		   exec-once exec-arg exec-multiple exec-missing exec-bad-ptr
		   join-simple join-twice join-killed join-bad-pid
		   multi-recurse multi-oom multi-child-fd);

# Default set of tests.
@TESTS =  unless @TESTS > 0;

clean_dir (), exit if $action eq 'clean';

extract_sources (); 
exit if $action eq 'extract';

build (); 
exit if $action eq 'build';

run_and_grade_tests (); 
write_grades (); 
write_details ();
exit if $action eq 'test';

assemble_final_grade ();
exit if $action eq 'assemble';

die "Don't know how to '$action'";

# Runs $test in directory output/$test.
# Returns 'ok' if it went ok, otherwise an explanation.
sub run_test {
    xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk",
	     DIE => "cp failed\n");

    my ($args) = "";
    $args = 'some arguments for you!'
	if grep ($_ eq $test, qw(args-argc args-argv0
				 args-argvn args-multiple));
    $args = 'onearg' if $test eq 'args-single';
    $args = 'two  args' if $test eq 'args-dbl-space';
    $args = '15' if $test eq 'multi-recurse';
    $args = '0' if $test eq 'multi-oom';
    $args = " $args" if $args ne '';

    # Run.
    my ($timeout) = $test !~ /^multi-/ ? 10 : 600;
    my ($result) = run_pintos ("pintos "
			       . "--os-disk=pintos/src/userprog/build/os.dsk "
			       . "--fs-disk=output/$test/fs.dsk "
			       . "-v run -q -ex \"$test$args\"",
			       LOG => "$test/run",
			       TIMEOUT => $timeout);
    rename "output/$test/fs.dsk", "output/$test/fs.dsk.keep"
	if $test eq 'write-normal';
    return $result;
}

sub grade_write_normal {
    my (@output) = @_;
    verify_common (@output);
    compare_output ("$GRADES_DIR/write-normal.exp", @output);
    my ($test_txt) = "output/$test/test.txt";
    get_file ("test.txt", $test_txt) if ! -e $test_txt;

    my (@actual) = snarf ($test_txt);
    my (@expected) = snarf ("$GRADES_DIR/sample.txt");

    my ($eq);
    if ($#actual == $#expected) {
	$eq = 1;
	for my $i (0...$#actual) {
	    $eq = 0 if $actual[$i] ne $expected[$i];
	}
    } else {
	$eq = 0;
    }
    if (!$eq) {
	my ($details);
	$details = "Expected file content:\n";
	$details .= join ('', map ("  $_\n", @expected));
	$details .= "Actual file content:\n";
	$details .= join ('', map ("  $_\n", @actual));
	$extra{$test} = $details;

	die "File written didn't have expected content.\n";
    }
}

sub grade_multi_oom {
    my (@output) = @_;
    verify_common (@output);

    @output = canonicalize_exit_codes (get_core_output (@output));
    my ($n) = 0;
    while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) {
	die "Child process $m started out of order.\n" if $m != $n;
	$n = $m + 1;
	shift @output;
    }
    die "Only $n child process(es) started.\n" if $n < 15;

    # There could be a death notice for a process that didn't get
    # fully loaded, and/or notices from the loader.
    while (@output > 0
	   && ($output[0] =~ /^multi-oom: exit\(-1\)$/
	       || $output[0] =~ /^load: /)) {
	shift @output;
    }

    while (--$n >= 0) {
	die "Output ended unexpectedly before process $n finished.\n"
	    if @output < 2;

	local ($_);
	chomp ($_ = shift @output);
	die "Found '$_' expecting 'end' message.\n" if !/^\(multi-oom\) end/;
	die "Child process $n ended out of order.\n"
	    if !/^\(multi-oom\) end $n$/;

	chomp ($_ = shift @output);
	die "Kernel didn't print proper exit message for process $n.\n"
	    if !/^multi-oom: exit\($n\)$/;
    }
    die "Spurious output at end: '$output[0]'.\n" if @output;
}

sub get_file {
    my ($guest_fn, $host_fn) = @_;
    my ($result) = run_pintos ("pintos "
			       . "--os-disk=pintos/src/userprog/build/os.dsk "
			       . "--fs-disk=output/$test/fs.dsk.keep "
			       . "-v get $guest_fn $host_fn",
			       LOG => "$test/get-$guest_fn",
			       TIMEOUT => 10,
			       EXPECT => 0);
    die "`pintos get $guest_fn' failed - $result\n"
	if $result ne 'ok';
}