#! /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) = "vm";
our (@TESTS);		# Tests to run.
our ($test);
our ($action);

parse_cmd_line qw (pt-grow-stack pt-big-stk-obj pt-bad-addr pt-write-code
		   page-linear page-parallel page-merge-seq page-merge-par
		   page-shuffle mmap-read mmap-close mmap-unmap mmap-overlap
		   mmap-twice mmap-write mmap-exit mmap-shuffle);

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 {
    # Set up output directory.
    xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk",
	     DIE => "cp failed\n");
    xsystem ("pintos make-disk output/$test/swap.dsk 2 >/dev/null 2>&1",
	     DIE => "failed to create swap disk");

    # Run.
    return run_pintos ("pintos "
		       . "--os-disk=pintos/src/vm/build/os.dsk "
		       . "--fs-disk=output/$test/fs.dsk "
		       . "--swap-disk=output/$test/swap.dsk "
		       . "-v run -q -ex \"$test\"",
		       LOG => "$test/run",
		       TIMEOUT => 600);
}

sub grade_process_death {
    my ($proc_name, @output) = @_;

    verify_common (@output);
    @output = get_core_output (@output);
    die "First line of output is not `($proc_name) begin' message.\n"
        if $output[0] ne "($proc_name) begin";
    die "Output contains `FAIL' message.\n"
        if grep (/FAIL/, @output);
    die "Output contains spurious ($proc_name) message.\n"
        if grep (/\($proc_name\)/, @output) > 1;
}

sub grade_pt_bad_addr {
    grade_process_death ('pt-bad-addr', @_);
}

sub grade_pt_write_code {
    grade_process_death ('pt-write-code', @_);
}

sub grade_mmap_unmap {
    grade_process_death ('mmap-unmap', @_);
}