#! /usr/bin/perl
+# Find the directory that contains the grading files.
+our ($GRADES_DIR);
+
+BEGIN {
+ ($GRADES_DIR = $0) =~ s#/[^/]+$##;
+ -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
+ unshift @INC, "$GRADES_DIR/../lib";
+}
+
use warnings;
use strict;
use POSIX;
exit 0;
}
-# Find the directory that contains the grading files.
-our ($GRADES_DIR);
-($GRADES_DIR = $0) =~ s#/[^/]+$##;
--d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
-
if ($clean) {
# Verify that we're roughly in the correct directory
# before we go blasting away files.
# Run.
my ($timeout) = 600;
my ($testargs) = defined ($args{$test}) ? " $args{$test}" : "";
- xsystem ("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$testargs\"",
- LOG => "$test/run",
- TIMEOUT => $timeout)
- or return "Bochs error";
-
- return "ok";
+ my ($result) = xsystem ("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$testargs\"",
+ LOG => "$test/run",
+ TIMEOUT => $timeout,
+ EXPECT => 1)
+ ? "ok" : "Bochs error";
+ unlink ("output/$test/fs.dsk", "output/$test/swap.dsk");
+ return $result;
}
sub grade_test {
return "ok";
}
\f
-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;
+sub grade_process_death {
+ my ($proc_name, @output) = @_;
- die "File written didn't have expected content.\n";
- }
-}
-
-sub grade_multi_oom {
- my (@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;
+}
- @output = fix_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 grade_pt_bad_addr {
+ grade_process_death ('pt-bad-addr', @_);
}
-sub get_file {
- my ($guest_fn, $host_fn) = @_;
- xsystem ("pintos "
- . "--os-disk=pintos/src/vm/build/os.dsk "
- . "--fs-disk=output/$test/fs.dsk "
- . "-v get $guest_fn $host_fn",
- LOG => "$test/get-$guest_fn",
- TIMEOUT => 10)
- or die "get $guest_fn failed\n";
+sub grade_pt_write_code {
+ grade_process_death ('pt-write-code', @_);
}
+sub grade_mmap_unmap {
+ grade_process_death ('mmap-unmap', @_);
+}
\f
sub verify_common {
my (@output) = @_;
die "fork: $!\n" if !defined $pid;
if (!$pid) {
if (defined $log) {
- close STDOUT;
open (STDOUT, ">output/$log.out");
- close STDERR;
open (STDERR, ">output/$log.err");
}
exec ($command);
$status = $?;
alarm 0;
};
+
+ my ($ok);
if ($@) {
die unless $@ eq "alarm\n"; # propagate unexpected errors
- print "Timed out $pid.\n";
- print "not killed\n" if !kill ('SIGTERM', $pid);
- $status = 0;
- }
+ print "Timed out: ";
+ for (my ($i) = 0; $i < 10; $i++) {
+ kill ('SIGTERM', $pid);
+ sleep (1);
+ my ($retval) = waitpid ($pid, WNOHANG);
+ last if $retval == $pid || $retval == -1;
+ print "Waiting for $pid to die" if $i == 0;
+ print ".";
+ }
+ $ok = 1;
+ } else {
+ if (WIFSIGNALED ($status)) {
+ my ($signal) = WTERMSIG ($status);
+ die "Interrupted\n" if $signal == SIGINT;
+ print "Child terminated with signal $signal\n";
+ }
- if (WIFSIGNALED ($status)) {
- my ($signal) = WTERMSIG ($status);
- die "Interrupted\n" if $signal == SIGINT;
- print "Child terminated with signal $signal\n";
+ my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
+ $ok = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status;
}
- unlink ("output/$log.err") if defined ($log) && $status == 0;
+ unlink ("output/$log.err") if defined ($log) && $ok;
- die $options{DIE} if $status != 0 && defined $options{DIE};
+ die $options{DIE} if !$ok && defined $options{DIE};
- return $status == 0;
+ return $ok;
}
sub snarf {
projects / pintos-anon / blobdiff