Add test scripts.

[pintos-anon] / grading / threads / run-tests

#! /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;
}