Finish up filesys grading stuff.
authorBen Pfaff <blp@cs.stanford.edu>
Thu, 9 Dec 2004 09:08:40 +0000 (09:08 +0000)
committerBen Pfaff <blp@cs.stanford.edu>
Thu, 9 Dec 2004 09:08:40 +0000 (09:08 +0000)
20 files changed:
TODO
grading/filesys/.cvsignore
grading/filesys/Make.progs
grading/filesys/lg-create.c [new file with mode: 0644]
grading/filesys/lg-create.exp [new file with mode: 0644]
grading/filesys/lg-full.c [new file with mode: 0644]
grading/filesys/lg-full.exp [new file with mode: 0644]
grading/filesys/lg-random.c [new file with mode: 0644]
grading/filesys/lg-random.exp [new file with mode: 0644]
grading/filesys/lg-seq-block.c [new file with mode: 0644]
grading/filesys/lg-seq-block.exp [new file with mode: 0644]
grading/filesys/lg-seq-random.c [new file with mode: 0644]
grading/filesys/lg-seq-random.exp [new file with mode: 0644]
grading/filesys/panic.diff [deleted file]
grading/filesys/patches/00panic.patch [new file with mode: 0644]
grading/filesys/review.txt [new file with mode: 0644]
grading/filesys/run-tests
grading/filesys/tests.txt
grading/lib/Pintos/Grading.pm
grading/vm/review.txt

diff --git a/TODO b/TODO
index 30f324682f09fc10a05eacd400ad8f1fa1ae6422..d04e89d8b0aa9d2cb47efbec44c102b5cebdc2a3 100644 (file)
--- a/TODO
+++ b/TODO
@@ -28,3 +28,7 @@
   Any reason not to use random_bytes()?
 
 * Grading script patches needed anymore?
+
+* Add a "real-time" option to `pintos' script so that 30 second
+  intervals can be accurately timed for HW#1 timer, HW#4 write-behind
+  cache.
index 01b7943908a4ac1340bba920a39b808c922a5903..8d6648a1cbfffe1db511d1a40e45f2d91eba126f 100644 (file)
@@ -37,6 +37,11 @@ sm-full
 sm-random
 sm-seq-block
 sm-seq-random
+lg-create
+lg-full
+lg-random
+lg-seq-block
+lg-seq-random
 syn-read
 syn-remove
 syn-rw
index 1aa2a8f226d0c1757095171b2a9cb10da9e72b39..329b78ae973007c9a4f7e1ed5a95ffd99e783de6 100644 (file)
@@ -1,6 +1,7 @@
 # -*- makefile -*-
 
 PROGS = sm-create sm-full sm-seq-block sm-seq-random sm-random         \
+lg-create lg-full lg-seq-block lg-seq-random lg-random         \
 grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell           \
 grow-sparse grow-too-big grow-root-sm grow-root-lg grow-dir-lg         \
 grow-two-files dir-mkdir dir-rmdir dir-mk-vine dir-rm-vine dir-mk-tree \
@@ -15,6 +16,12 @@ sm_seq_block_SRC = sm-seq-block.c fslib.c fsmain.c
 sm_seq_random_SRC = sm-seq-random.c fslib.c fsmain.c
 sm_random_SRC = sm-random.c fslib.c fsmain.c
 
+lg_create_SRC = lg-create.c fslib.c fsmain.c
+lg_full_SRC = lg-full.c fslib.c fsmain.c
+lg_seq_block_SRC = lg-seq-block.c fslib.c fsmain.c
+lg_seq_random_SRC = lg-seq-random.c fslib.c fsmain.c
+lg_random_SRC = lg-random.c fslib.c fsmain.c
+
 grow_create_SRC = grow-create.c fslib.c fsmain.c
 grow_seq_sm_SRC = grow-seq-sm.c fslib.c fsmain.c
 grow_seq_lg_SRC = grow-seq-lg.c fslib.c fsmain.c
diff --git a/grading/filesys/lg-create.c b/grading/filesys/lg-create.c
new file mode 100644 (file)
index 0000000..c419e14
--- /dev/null
@@ -0,0 +1,3 @@
+const char test_name[] = "sm-create";
+#define TEST_SIZE 75678
+#include "create.inc"
diff --git a/grading/filesys/lg-create.exp b/grading/filesys/lg-create.exp
new file mode 100644 (file)
index 0000000..4bc3b9a
--- /dev/null
@@ -0,0 +1,5 @@
+(sm-create) begin
+(sm-create) create "blargle"
+(sm-create) open "blargle" for verification
+(sm-create) close "blargle"
+(sm-create) end
diff --git a/grading/filesys/lg-full.c b/grading/filesys/lg-full.c
new file mode 100644 (file)
index 0000000..cd21ee6
--- /dev/null
@@ -0,0 +1,3 @@
+const char test_name[] = "sm-full";
+#define TEST_SIZE 75678
+#include "full.inc"
diff --git a/grading/filesys/lg-full.exp b/grading/filesys/lg-full.exp
new file mode 100644 (file)
index 0000000..44c99ee
--- /dev/null
@@ -0,0 +1,8 @@
+(sm-full) begin
+(sm-full) create "quux"
+(sm-full) open "quux"
+(sm-full) writing "quux"
+(sm-full) close "quux"
+(sm-full) open "quux" for verification
+(sm-full) close "quux"
+(sm-full) end
diff --git a/grading/filesys/lg-random.c b/grading/filesys/lg-random.c
new file mode 100644 (file)
index 0000000..689246a
--- /dev/null
@@ -0,0 +1,4 @@
+const char test_name[] = "sm-random";
+#define BLOCK_SIZE 512
+#define TEST_SIZE (512 * 150)
+#include "random.inc"
diff --git a/grading/filesys/lg-random.exp b/grading/filesys/lg-random.exp
new file mode 100644 (file)
index 0000000..37adb48
--- /dev/null
@@ -0,0 +1,7 @@
+(sm-random) begin
+(sm-random) create "bazzle"
+(sm-random) open "bazzle"
+(sm-random) write "bazzle" in random order
+(sm-random) read "bazzle" in random order
+(sm-random) close "bazzle"
+(sm-random) end
diff --git a/grading/filesys/lg-seq-block.c b/grading/filesys/lg-seq-block.c
new file mode 100644 (file)
index 0000000..0a2df57
--- /dev/null
@@ -0,0 +1,4 @@
+const char test_name[] = "sm-seq-block";
+#define TEST_SIZE 75678
+#define BLOCK_SIZE 513
+#include "seq-block.inc"
diff --git a/grading/filesys/lg-seq-block.exp b/grading/filesys/lg-seq-block.exp
new file mode 100644 (file)
index 0000000..f7b4ccc
--- /dev/null
@@ -0,0 +1,8 @@
+(sm-seq-block) begin
+(sm-seq-block) create "noodle"
+(sm-seq-block) open "noodle"
+(sm-seq-block) writing "noodle"
+(sm-seq-block) close "noodle"
+(sm-seq-block) open "noodle" for verification
+(sm-seq-block) close "noodle"
+(sm-seq-block) end
diff --git a/grading/filesys/lg-seq-random.c b/grading/filesys/lg-seq-random.c
new file mode 100644 (file)
index 0000000..9e19c74
--- /dev/null
@@ -0,0 +1,3 @@
+const char test_name[] = "sm-seq-random";
+#define TEST_SIZE 75678
+#include "seq-random.inc"
diff --git a/grading/filesys/lg-seq-random.exp b/grading/filesys/lg-seq-random.exp
new file mode 100644 (file)
index 0000000..9432552
--- /dev/null
@@ -0,0 +1,8 @@
+(sm-seq-random) begin
+(sm-seq-random) create "nibble"
+(sm-seq-random) open "nibble"
+(sm-seq-random) writing "nibble"
+(sm-seq-random) close "nibble"
+(sm-seq-random) open "nibble" for verification
+(sm-seq-random) close "nibble"
+(sm-seq-random) end
diff --git a/grading/filesys/panic.diff b/grading/filesys/panic.diff
deleted file mode 100644 (file)
index 6134d47..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-diff -up /home/blp/cs140/pintos/src/lib/debug.c.\~1.8.\~ /home/blp/cs140/pintos/src/lib/debug.c
---- /home/blp/cs140/pintos/src/lib/debug.c.~1.8.~      2004-09-12 13:14:11.000000000 -0700
-+++ /home/blp/cs140/pintos/src/lib/debug.c     2004-10-17 00:02:32.000000000 -0700
-@@ -5,6 +5,7 @@
- #include <stdio.h>
- #include <string.h>
- #ifdef KERNEL
-+#include "threads/init.h"
- #include "threads/interrupt.h"
- #include "devices/serial.h"
- #else
-@@ -83,7 +84,7 @@ debug_panic (const char *file, int line,
- #ifdef KERNEL
-   serial_flush ();
--  for (;;);
-+  power_off ();
- #else
-   exit (1);
- #endif
diff --git a/grading/filesys/patches/00panic.patch b/grading/filesys/patches/00panic.patch
new file mode 100644 (file)
index 0000000..b7d68f0
--- /dev/null
@@ -0,0 +1,23 @@
+This patch forces debug_panic() to terminate Bochs.
+It is in upstream now, so it is probably time to remove it.
+
+diff -up pintos/src/lib/debug.c~ pintos/src/lib/debug.c
+--- pintos/src/lib/debug.c~    2004-09-12 13:14:11.000000000 -0700
++++ pintos/src/lib/debug.c     2004-10-17 00:02:32.000000000 -0700
+@@ -5,6 +5,7 @@
+ #include <stdio.h>
+ #include <string.h>
+ #ifdef KERNEL
++#include "threads/init.h"
+ #include "threads/interrupt.h"
+ #include "devices/serial.h"
+ #else
+@@ -83,7 +84,7 @@ debug_panic (const char *file, int line,
+ #ifdef KERNEL
+   serial_flush ();
+-  for (;;);
++  power_off ();
+ #else
+   exit (1);
+ #endif
diff --git a/grading/filesys/review.txt b/grading/filesys/review.txt
new file mode 100644 (file)
index 0000000..c53a801
--- /dev/null
@@ -0,0 +1,61 @@
+TESTCASES [[/10]]
+-----------------
+  -3 Didn't test/explain large files
+  -3 Didn't test/explain file growth
+  -2 Didn't test/explain directories
+  -2 Didn't test/explain cache performance
+  +1...+3 Bonus for demonstrating VM running on file system
+
+
+DESIGN [[/40]]
+--------------
+
+DESIGNDOC
+  -5 Doesn't explain synchronization
+  -5 Doesn't explain inode design (e.g. direct, indirect, etc. structure)
+  -5 Doesn't explain block cache structure
+  -5 Doesn't explain read-ahead/write-behind design
+
+Overall:
+  -1 Gratuitous use of malloc() (e.g. for allocating a list or a lock)
+  -1 Inappropriate use of ASSERT (e.g. to verify that malloc() succeeded)
+
+Synchronization and consistency
+  -5 One big lock for entire file system
+  -3 Doesn't mark inode deleted in bitmap when file removed and closed
+  -2 Doesn't mark indirect blocks deleted in bitmap when file removed, closed
+  -5 Keeps copy of inode_disk in inode but doesn't account for it in cache
+
+Large Files
+  -5 No direct blocks
+  -10 No indirect or doubly indirect blocks of any sort
+
+Subdirectories
+  -2 Directories cannot grow
+  +1 Supports Unix-like . and ..
+  +2 Supports recursive directory removal
+
+Buffer Cache
+  -3 Uses linear search instead of hash table, etc.
+  -2 Poor cache replacement algorithm (not LRU, etc.)
+  -1 Does not prioritize metadata in cache
+  -2 Locks entire cache during I/O
+
+Read-Ahead/Write-Behind (max -10)
+  -7 No read-ahead
+  -7 No write-behind
+  -5 Busy-waiting in write-behind thread
+  -2 Spawns a new thread on every block read
+  +2 Prioritizes real reads over read-ahead
+    
+
+STYLE [[/10]]
+-------------
+  -5...-10 Fixing code after submission
+  -5 Doesn't compile as submitted
+  +1...+5 Cool test programs etc.
+
+
+COMMENTS
+--------
+
index d683f7ce1103d93b5fb59cf08c8618c4e550e871..7e7b0e9a28a4d69b1b59c9e0c821b2fb40787c14 100755 (executable)
@@ -12,45 +12,21 @@ BEGIN {
 
 use warnings;
 use strict;
-use POSIX;
-use Algorithm::Diff;
-use Getopt::Long;
 use Pintos::Grading;
 
-our ($test);
+our ($hw) = "filesys";
 our ($verbose) = 0;    # Verbosity of output
 our (@TESTS);          # Tests to run.
-my ($clean) = 0;
-my ($grade) = 0;
+our ($clean) = 0;
+our ($grade) = 0;
 
-GetOptions ("v|verbose+" => \$verbose,
-           "h|help" => sub { usage (0) },
-           "t|test=s" => \@TESTS,
-           "c|clean" => \$clean,
-           "g|grade" => \$grade)
-    or die "Malformed command line; use --help for help.\n";
-die "Non-option argument not supported; use --help for help.\n"
-    if @ARGV > 0;
-
-sub usage {
-    my ($exitcode) = @_;
-    print "run-tests, for grading Pintos multiprogramming projects.\n\n";
-    print "Invoke from a directory containing a student tarball named by\n";
-    print "the submit script, e.g. username.Oct.12.04.20.04.09.tar.gz.\n";
-    print "In normal usage, no options are needed.\n\n";
-    print "Output is produced in tests.out and details.out.\n\n";
-    print "Options:\n";
-    print "  -c, --clean     Remove old output files before starting\n";
-    print "  -t, --test=TEST Execute TEST only (allowed multiple times)\n";
-    print "  -g, --grade     Instead of running tests, compose grade.out\n";
-    print "  -v, --verbose   Print commands before executing them\n";
-    print "  -h, --help      Print this help message\n";
-    exit $exitcode;
-}
+parse_cmd_line ();
 
 # Default set of tests.
 @TESTS = qw (sm-create sm-full sm-seq-block sm-seq-random sm-random
 
+            lg-create lg-full lg-seq-block lg-seq-random lg-random
+
             grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell
             grow-sparse grow-too-big grow-root-sm grow-root-lg grow-dir-lg 
             grow-two-files
@@ -63,68 +39,8 @@ sub usage {
             syn-remove syn-read syn-write syn-rw
             ) unless @TESTS > 0;
 
-our (%args);
-
-# Handle final grade mode.
-if ($grade) {
-    open (OUT, ">grade.out") or die "grade.out: create: $!\n";
-
-    open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
-    while (<GRADE>) {
-       last if /^\s*$/;
-       print OUT;
-    }
-    close (GRADE);
-    
-    my (@tests) = snarf ("tests.out");
-    my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
-
-    my (@review) = snarf ("review.txt");
-    my ($part_lost) = (0, 0);
-    for (my ($i) = $#review; $i >= 0; $i--) {
-       local ($_) = $review[$i];
-       if (my ($loss) = /^\s*([-+]\d+)/) {
-           $part_lost += $loss;
-       } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
-           my ($got) = $out_of + $part_lost;
-           $got = 0 if $got < 0;
-           $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
-           $part_lost = 0;
-
-           $p_got += $got;
-           $p_pos += $out_of;
-       }
-    }
-    die "Lost points outside a section\n" if $part_lost;
-
-    for (my ($i) = 1; $i <= $#review; $i++) {
-       if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
-           $review[$i] = '-' x (length ($review[$i - 1]));
-       }
-    }
-
-    print OUT "\nOVERALL SCORE\n";
-    print OUT "-------------\n";
-    print OUT "$p_got points out of $p_pos total\n\n";
-
-    print OUT map ("$_\n", @tests), "\n";
-    print OUT map ("$_\n", @review), "\n";
-
-    print OUT "DETAILS\n";
-    print OUT "-------\n\n";
-    print OUT map ("$_\n", snarf ("details.out"));
-
-    exit 0;
-}
-
-if ($clean) {
-    # Verify that we're roughly in the correct directory
-    # before we go blasting away files.
-    choose_tarball ();
-
-    xsystem ("rm -rf output pintos", VERBOSE => 1);
-    xsystem ("rm -f details.out tests.out", VERBOSE => 1);
-}
+compose_final_grade (), exit 0 if $grade;
+clean_dir (), exit 0 if $clean;
 
 # Create output directory, if it doesn't already exist.
 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
@@ -139,406 +55,48 @@ compile ();
 -d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
 
 # Run and grade the tests.
-our %result;
-our %details;
-our %extra;
-for $test (@TESTS) {
-    print "$test: ";
-    my ($result) = get_test_result ();
-    if ($result eq 'ok') {
-       $result = grade_test ($test);
-    } elsif ($result =~ /^Timed out/) {
-       $result = "$result - " . grade_test ($test);
-    }
-    chomp ($result);
-    print "$result";
-    print " - with warnings" if $result eq 'ok' && defined $details{$test};
-    print "\n";
-    
-    $result{$test} = $result;
-}
+run_and_grade_tests ();
 
 # Write output.
 write_grades ();
 write_details ();
-\f
-\f
-sub grade_process_death {
-    my ($proc_name, @output) = @_;
 
+sub grade_dir_lsdir {
+    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;
-}
-
-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', @_);
-}
-\f
-sub verify_common {
-    my (@output) = @_;
-
-    my (@assertion) = grep (/PANIC/, @output);
-    if (@assertion != 0) {
-       my ($details) = "Kernel panic:\n  $assertion[0]\n";
-
-       my (@stack_line) = grep (/Call stack:/, @output);
-       if (@stack_line != 0) {
-           $details .= "  $stack_line[0]\n\n";
-           $details .= "Translation of backtrace:\n";
-           my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
-
-           my ($A2L);
-           if (`uname -m`
-               =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
-               $A2L = "addr2line";
-           } else {
-               $A2L = "i386-elf-addr2line";
-           }
-           open (A2L, "$A2L -fe pintos/src/filesys/build/kernel.o @addrs|");
-           for (;;) {
-               my ($function, $line);
-               last unless defined ($function = <A2L>);
-               $line = <A2L>;
-               chomp $function;
-               chomp $line;
-               $details .= "  $function ($line)\n";
-           }
-       }
 
-       if ($assertion[0] =~ /sec_no < d->capacity/) {
-           $details .= <<EOF;
-\nThis assertion commonly fails when accessing a file via
-an inode that has been closed and freed.  Freeing an inode
-clears all its sector indexes to 0xcccccccc, which is not
-a valid sector number for disks smaller than about 1.6 TB.
-EOF
-       }
-
-       $extra{$test} = $details;
-       die "Kernel panic.  Details at end of file.\n"
+    my ($begin);
+    for my $i (0...$#output) {
+       $begin = $i, last if $output[$i] eq '(dir-lsdir) begin';
     }
+    die "\"(dir-lsdir) begin\" does not appear in output\n" if !defined $begin;
 
-    my (@failure) = grep (/FAIL/, @output);
-    if (@failure != 0) {
-       eval {
-           my (@core) = get_core_output (@output);
-           $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
-       };
-       my ($failure) = $failure[0];
-       $failure =~ s/^\([^)]+\)\s+//;
-       die "Failed with message \"$failure\"\n";
+    my ($end);
+    for my $i (0...$#output) {
+       $end = $i, last if $output[$i] eq '(dir-lsdir) end';
     }
+    die "\"(dir-lsdir) end\" does not appear in output\n" if !defined $end;
+    die "\"begin\" follows \"end\" in output\n" if $begin > $end;
 
-    if (grep (/Pintos booting/, @output) > 1) {
-       my ($details);
-
-       $details = "Pintos spontaneously rebooted during this test.\n";
-       $details .= "This is most often due to unhandled page faults.\n";
-       $details .= "Here's the output from the initial boot through the\n";
-       $details .= "first reboot:\n\n";
-
-       my ($i) = 0;
-       local ($_);
-       for (@output) {
-           $details .= "  $_\n";
-           last if /Pintos booting/ && ++$i > 1;
-       }
-       $details{$test} = $details;
-       die "Triple-fault caused spontaneous reboot(s).  "
-           . "Details at end of file.\n";
+    my (%count);
+    for my $fn (@output[$begin + 1...$end - 1]) {
+       $fn =~ s/\s+$//;
+       die "Unexpected file \"$fn\" in lsdir output\n"
+           unless grep ($_ eq $fn, qw (. .. dir-lsdir));
+       die "File \"$fn\" listed twice in lsdir output\n"
+           if $count{$fn};
+       $count{$fn}++;
     }
-
-    die "No output at all\n" if @output == 0;
-    die "Didn't start up properly: no \"Pintos booting\" startup message\n"
-       if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
-    die "Didn't start up properly: no \"Boot complete\" startup message\n"
-       if !grep (/Boot complete/, @output);
-    die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
-        if !grep (/Timer: \d+ ticks/, @output);
-    die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
-       if !grep (/Powering off/, @output);
+    die "No files in lsdir output\n" if scalar (keys (%count)) == 0;
+    die "File \"dir-lsdir\" missing from lsdir output\n"
+       if !$count{"dir-lsdir"};
 }
 
-# Get @output without header or trailer.
-sub get_core_output {
-    my (@output) = @_;
-
-    my ($first);
-    for ($first = 0; $first <= $#output; $first++) {
-       $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
-    }
-
-    my ($last);
-    for ($last = $#output; $last >= 0; $last--) {
-       $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
-    }
-
-    if ($last < $first) {
-       my ($no_first) = $first > $#output;
-       my ($no_last) = $last < $#output;
-       die "Couldn't locate output.\n";
-    }
-
-    return @output[$first ... $last];
-}
-
-sub fix_exit_codes {
-    my (@output) = @_;
-
-    # Remove lines that look like exit codes.
-    # Exit codes are supposed to be printed in the form "process: exit(code)"
-    # but people get unfortunately creative with it.
-    for (my ($i) = 0; $i <= $#output; $i++) {
-       local ($_) = $output[$i];
-       
-       my ($process, $code);
-       if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
-           || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
-           || (($process, $code)
-               = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
-           || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
-           || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/)
-           ) {
-           splice (@output, $i, 1);
-           $i--;
-       }
-    }
-
-    return @output;
-}
-
-sub compare_output {
-    my ($exp, @actual) = @_;
-    @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual)));
-    die "Program produced no output.\n" if !@actual;
-
-    my ($details) = "";
-    $details .= "$test actual output:\n";
-    $details .= join ('', map ("  $_", @actual));
-
-    my (@exp) = map ("$_\n", snarf ($exp));
-
-    my ($fuzzy_match) = 0;
-    while (@exp != 0) {
-       my (@expected);
-       while (@exp != 0) {
-           my ($s) = shift (@exp);
-           last if $s eq "--OR--\n";
-           push (@expected, $s);
-       }
-
-       $details .= "\n$test acceptable output:\n";
-       $details .= join ('', map ("  $_", @expected));
-
-       # 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) = "";
-       my ($d) = Algorithm::Diff->new (\@expected, \@actual);
-       my ($not_fuzzy_match) = 0;
-       while ($d->Next ()) {
-           my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
-           if ($d->Same ()) {
-               push (@diff, map ("  $_", $d->Items (1)));
-           } else {
-               push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
-               push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
-               if ($d->Items (1)
-                   || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
-                            $d->Items (2))) {
-                   $not_fuzzy_match = 1;
-               }
-           }
-       }
-       $fuzzy_match = 1 if !$not_fuzzy_match;
-
-       $details .= "Differences in `diff -u' format:\n";
-       $details .= join ('', @diff);
-       $details .= "(This is considered a `fuzzy match'.)\n"
-           if !$not_fuzzy_match;
-    }
-
-    if ($fuzzy_match) {
-       $details =
-           "This test passed, but with extra, unexpected output.\n"
-           . "Please inspect your code to make sure that it does not\n"
-           . "produce output other than as specified in the project\n"
-           . "description.\n\n"
-           . "$details";
-    } else {
-       $details =
-           "This test failed because its output did not match any\n"
-           . "of the acceptable form(s).\n\n"
-           . "$details";
-    }
-
-    $details{$test} = $details;
-    die "Output differs from expected.  Details at end of file.\n"
-       unless $fuzzy_match;
-}
-\f
-sub write_grades {
-    my (@summary) = snarf ("$GRADES_DIR/tests.txt");
-
-    my ($ploss) = 0;
-    my ($tloss) = 0;
-    my ($total) = 0;
-    my ($warnings) = 0;
-    for (my ($i) = 0; $i <= $#summary; $i++) {
-       local ($_) = $summary[$i];
-       if (my ($loss, $test) = /^  -(\d+) ([-a-zA-Z0-9]+):/) {
-           my ($result) = $result{$test} || "Not tested.";
-
-           if ($result eq 'ok') {
-               if (!defined $details{$test}) {
-                   # Test successful and no warnings.
-                   splice (@summary, $i, 1);
-                   $i--;
-               } else {
-                   # Test successful with warnings.
-                   s/-(\d+) //;
-                   $summary[$i] = $_;
-                   splice (@summary, $i + 1, 0,
-                           "     Test passed with warnings.  "
-                           . "Details at end of file.");
-                   $warnings++;
-               } 
-           } else {
-               $ploss += $loss;
-               $tloss += $loss;
-               splice (@summary, $i + 1, 0,
-                       map ("     $_", split ("\n", $result)));
-           }
-       } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
-           $total += $ptotal;
-           $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
-           splice (@summary, $i, 0, "  All tests passed.")
-               if $ploss == 0 && !$warnings;
-           $ploss = 0;
-           $warnings = 0;
-           $i++;
-       }
-    }
-    my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
-    $summary[0] =~ s/\[\[total\]\]/$ts/;
-
-    open (SUMMARY, ">tests.out");
-    print SUMMARY map ("$_\n", @summary);
-    close (SUMMARY);
-}
-
-sub write_details {
-    open (DETAILS, ">details.out");
-    my ($n) = 0;
-    for $test (@TESTS) {
-       next if $result{$test} eq 'ok' && !defined $details{$test};
-       
-       my ($details) = $details{$test};
-       next if !defined ($details) && ! -e "output/$test/run.out";
-
-       my ($banner);
-       if ($result{$test} ne 'ok') {
-           $banner = "$test failure details"; 
-       } else {
-           $banner = "$test warnings";
-       }
-
-       print DETAILS "\n" if $n++;
-       print DETAILS "--- $banner ", '-' x (50 - length ($banner));
-       print DETAILS "\n\n";
-
-       if (!defined $details) {
-           my (@output) = snarf ("output/$test/run.out");
-
-           # Print only the first in a series of recursing panics.
-           my ($panic) = 0;
-           for my $i (0...$#output) {
-               local ($_) = $output[$i];
-               if (/PANIC/ && $panic++ > 0) {
-                   @output = @output[0...$i];
-                   push (@output,
-                         "[...details of recursive panic(s) omitted...]");
-                   last;
-               }
-           }
-           $details = "Output:\n\n" . join ('', map ("$_\n", @output));
-       }
-       print DETAILS $details;
-
-       print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
-           if defined $extra{$test};
-    }
-    close (DETAILS);
-
-}
-\f
-sub snarf {
-    my ($file) = @_;
-    open (OUTPUT, $file) or die "$file: open: $!\n";
-    my (@lines) = <OUTPUT>;
-    chomp (@lines);
-    close (OUTPUT);
-    return wantarray ? @lines : join ('', map ("$_\n", @lines));
-}
-
-sub files_equal {
-    my ($a, $b) = @_;
-    my ($equal);
-    open (A, "<$a") or die "$a: open: $!\n";
-    open (B, "<$b") or die "$b: open: $!\n";
-    if (-s A != -s B) {
-       $equal = 0;
-    } else {
-       my ($sa, $sb);
-       for (;;) {
-           sysread (A, $sa, 1024);
-           sysread (B, $sb, 1024);
-           $equal = 0, last if $sa ne $sb;
-           $equal = 1, last if $sa eq '';
-       }
-    }
-    close (A);
-    close (B);
-    return $equal;
-}
-
-sub file_contains {
-    my ($file, $expected) = @_;
-    open (FILE, "<$file") or die "$file: open: $!\n";
-    my ($actual);
-    sysread (FILE, $actual, -s FILE);
-    my ($equal) = $actual eq $expected;
-    close (FILE);
-    return $equal;
-}
-
-sub number_lines {
-    my ($ln, $lines) = @_;
-    my ($out);
-    for my $line (@$lines) {
-       chomp $line;
-       $out .= sprintf "%4d  %s\n", $ln++, $line;
-    }
-    return $out;
+# This should be improved, but none of the fall 2004 submissions
+# survived the test!
+# I suppose it could be a bug in the test but a lot of the submissions
+# had kernel panics, etc.
+sub grade_syn_rw {
+    verify_common (@_);
 }
index 837ca2b6a26aaee4f4611173414a4a282de7c9a5..5818cac7891db4ece606e2aa6a3a7ced14d831bf 100644 (file)
@@ -1,57 +1,57 @@
 CORRECTNESS [[total]]
 ---------------------
 
-Small files (< 63 kB)
-  sm-create: create small file, verify initialization to zeros
-  sm-full: write small file in single system call, reread to verify
-  sm-seq-block: write small file one block at a time, reread to verify
-  sm-seq-random: write small file a random amount at a time, reread to verify
-  sm-random: write small file randomly, reread randomly to verify
+Small files (<= 63 kB)
+  -1 sm-create: create small file, verify initialization to zeros
+  -1 sm-full: write small file in single system call, reread to verify
+  -1 sm-seq-block: write small file one block at a time, reread to verify
+  -1 sm-seq-random: write small file a random amount at a time, reread & verify
+  -1 sm-random: write small file randomly, reread randomly to verify
 Score: /5
 
-Large files (>= 63 kB)
-  lg-create: create large file, verify initialization to zeros
-  lg-full: write large file in single system call, reread to verify
-  lg-seq-block: write large file one block at a time, reread to verify
-  lg-seq-random: write large file a random amount at a time, reread to verify
-  lg-random: write large file randomly, reread randomly to verify
-Score: /
+Large files (> 63 kB)
+  -1 lg-create: create large file, verify initialization to zeros
+  -1 lg-full: write large file in single system call, reread to verify
+  -1 lg-seq-block: write large file one block at a time, reread to verify
+  -1 lg-seq-random: write large file a random amount at a time, reread & verify
+  -1 lg-random: write large file randomly, reread randomly to verify
+Score: /5
 
 File growth
-  grow-create: create empty file, verify
-  grow-seq-sm: extend empty file sequentially to small size, verify
-  grow-seq-lg: extend empty file sequentially to large size, verify
-  grow-file-size: filesize must return proper value as file grows
-  grow-tell: tell must return proper value as file grows
-  grow-sparse: create empty file, seek past 64 kB, write byte, verify zeroing
-  grow-too-big: create empty file, seek past 2 GB, write byte, must not crash
-  grow-root-sm: create 20 small files in root directory
-  grow-root-lg: create 50 small files in root directory
-  grow-dir-lg: create subdirectory, create 50 small files in it
-  grow-two-files: growing two files alternately must work
-Score: /
+  -1 grow-create: create empty file, verify
+  -1 grow-seq-sm: extend empty file sequentially to small size, verify
+  -1 grow-seq-lg: extend empty file sequentially to large size, verify
+  -1 grow-file-size: filesize must return proper value as file grows
+  -1 grow-tell: tell must return proper value as file grows
+  -1 grow-sparse: create empty file, seek past 64 kB, write byte, verify zeros
+  -1 grow-too-big: create empty file, seek past 2 GB, write byte, can't crash
+  -1 grow-root-sm: create 20 small files in root directory
+  -1 grow-root-lg: create 50 small files in root directory
+  -1 grow-dir-lg: create subdirectory, create 50 small files in it
+  -1 grow-two-files: growing two files alternately must work
+Score: /11
 
 Subdirectories and file management
-  dir-mkdir: mkdir a, create a/b, chdir a, open b
-  dir-rmdir: create directory, remove directory, chdir into it must now fail
-  dir-mk-vine: create deep chain of directories, create & check files in them
-  dir-rm-vine: create and remove deep chain of directories
-  dir-mk-tree: create wide, deep directory tree, create & check files in it
-  dir-rm-tree: create and remove wide, deep directory tree
-  dir-lsdir: lsdir must work
-  dir-rm-cwd: removing current directory must not crash
-  dir-rm-cwd-cd: if current directory removable, then cd'ing to it must fail
-  dir-rm-parent: removing current directory and then its parent must not crash
-  dir-rm-root: must not be able to remove root directory
-  dir-over-file: creating a directory named after an existing file must fail
-  dir-under-file: creating a file named after an existing directory must fail
-  dir-empty-name: creating a file named after the empty string must fail
-  dir-open: if directories can be opened as files, then writing them must fail
-Score: /
+  -1 dir-mkdir: mkdir a, create a/b, chdir a, open b
+  -1 dir-rmdir: create directory, remove directory, chdir into it must now fail
+  -1 dir-mk-vine: create deep chain of directories, create & check files inside
+  -1 dir-rm-vine: create and remove deep chain of directories
+  -1 dir-mk-tree: create wide, deep directory tree, create & check files in it
+  -1 dir-rm-tree: create and remove wide, deep directory tree
+  -1 dir-lsdir: lsdir must work
+  -1 dir-rm-cwd: removing current directory must not crash
+  -1 dir-rm-cwd-cd: if current directory removable, then cd'ing to it must fail
+  -1 dir-rm-parent: removing current directory and then its parent can't crash
+  -1 dir-rm-root: must not be able to remove root directory
+  -1 dir-over-file: creating a directory named after an existing file must fail
+  -1 dir-under-file: creating file named after existing directory must fail
+  -1 dir-empty-name: creating file named after the empty string must fail
+  -1 dir-open: if directories openable as files, writing them must fail
+Score: /15
 
 Synchronization
-  syn-remove: read and write deleted file
-  syn-read: one process writes file then many read it
-  syn-write: many processes write different parts of file, then verify
-  syn-rw: one process extends file sequentially as many read it sequentially
-Score: /
+  -1 syn-remove: read and write deleted file
+  -1 syn-read: one process writes file then many read it
+  -1 syn-write: many processes write different parts of file, then verify
+  -1 syn-rw: one process extends file sequentially as many read it sequentially
+Score: /4
index d0376ef1c601111fac34d227e041e8cc54d34010..200b779ebbcbe853ff9d09893fe399c7a6e9c098 100644 (file)
@@ -6,9 +6,44 @@ our ($test);
 our ($GRADES_DIR);
 our ($verbose);
 our (%args);
+our %result;
+our %details;
+our %extra;
+our @TESTS;
+our $clean;
+our $grade;
+our $hw;
 
-use Getopt::Long;
 use POSIX;
+use Getopt::Long;
+use Algorithm::Diff;
+\f
+sub parse_cmd_line {
+    GetOptions ("v|verbose+" => \$verbose,
+               "h|help" => sub { usage (0) },
+               "t|test=s" => \@TESTS,
+               "c|clean" => \$clean,
+               "g|grade" => \$grade)
+       or die "Malformed command line; use --help for help.\n";
+    die "Non-option argument not supported; use --help for help.\n"
+       if @ARGV > 0;
+}
+
+sub usage {
+    my ($exitcode) = @_;
+    print "run-tests, for grading Pintos projects.\n\n";
+    print "Invoke from a directory containing a student tarball named by\n";
+    print "the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz.\n";
+    print "In normal usage, no options are needed.\n\n";
+    print "Output is produced in tests.out and details.out.\n\n";
+    print "Options:\n";
+    print "  -c, --clean     Remove old output files before starting\n";
+    print "  -t, --test=TEST Execute TEST only (allowed multiple times)\n";
+    print "  -g, --grade     Instead of running tests, compose grade.out\n";
+    print "  -v, --verbose   Print commands before executing them\n";
+    print "  -h, --help      Print this help message\n";
+    exit $exitcode;
+}
 \f
 # Source tarballs.
 
@@ -46,6 +81,7 @@ sub obtain_sources {
     for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
        my ($stem);
        ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
+       print "Applying $patch...\n";
        xsystem ("patch -fs -p0 < $patch",
                 LOG => $stem, DIE => "applying patch $stem failed\n");
     }
@@ -96,7 +132,121 @@ sub compile {
        or return "compile error";
 }
 \f
+# Run and grade the tests.
+sub run_and_grade_tests {
+    for $test (@TESTS) {
+       print "$test: ";
+       my ($result) = get_test_result ();
+       if ($result eq 'ok') {
+           $result = grade_test ($test);
+       } elsif ($result =~ /^Timed out/) {
+           $result = "$result - " . grade_test ($test);
+       }
+       chomp ($result);
+       print "$result";
+       print " - with warnings" if $result eq 'ok' && defined $details{$test};
+       print "\n";
+       
+       $result{$test} = $result;
+    }
+}
+
+# Write test grades to tests.out.
+sub write_grades {
+    my (@summary) = snarf ("$GRADES_DIR/tests.txt");
+
+    my ($ploss) = 0;
+    my ($tloss) = 0;
+    my ($total) = 0;
+    my ($warnings) = 0;
+    for (my ($i) = 0; $i <= $#summary; $i++) {
+       local ($_) = $summary[$i];
+       if (my ($loss, $test) = /^  -(\d+) ([-a-zA-Z0-9]+):/) {
+           my ($result) = $result{$test} || "Not tested.";
+
+           if ($result eq 'ok') {
+               if (!defined $details{$test}) {
+                   # Test successful and no warnings.
+                   splice (@summary, $i, 1);
+                   $i--;
+               } else {
+                   # Test successful with warnings.
+                   s/-(\d+) //;
+                   $summary[$i] = $_;
+                   splice (@summary, $i + 1, 0,
+                           "     Test passed with warnings.  "
+                           . "Details at end of file.");
+                   $warnings++;
+               } 
+           } else {
+               $ploss += $loss;
+               $tloss += $loss;
+               splice (@summary, $i + 1, 0,
+                       map ("     $_", split ("\n", $result)));
+           }
+       } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
+           $total += $ptotal;
+           $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
+           splice (@summary, $i, 0, "  All tests passed.")
+               if $ploss == 0 && !$warnings;
+           $ploss = 0;
+           $warnings = 0;
+           $i++;
+       }
+    }
+    my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
+    $summary[0] =~ s/\[\[total\]\]/$ts/;
+
+    open (SUMMARY, ">tests.out");
+    print SUMMARY map ("$_\n", @summary);
+    close (SUMMARY);
+}
+
+# Write failure and warning details to details.out.
+sub write_details {
+    open (DETAILS, ">details.out");
+    my ($n) = 0;
+    for $test (@TESTS) {
+       next if $result{$test} eq 'ok' && !defined $details{$test};
+       
+       my ($details) = $details{$test};
+       next if !defined ($details) && ! -e "output/$test/run.out";
+
+       my ($banner);
+       if ($result{$test} ne 'ok') {
+           $banner = "$test failure details"; 
+       } else {
+           $banner = "$test warnings";
+       }
 
+       print DETAILS "\n" if $n++;
+       print DETAILS "--- $banner ", '-' x (50 - length ($banner));
+       print DETAILS "\n\n";
+
+       if (!defined $details) {
+           my (@output) = snarf ("output/$test/run.out");
+
+           # Print only the first in a series of recursing panics.
+           my ($panic) = 0;
+           for my $i (0...$#output) {
+               local ($_) = $output[$i];
+               if (/PANIC/ && $panic++ > 0) {
+                   @output = @output[0...$i];
+                   push (@output,
+                         "[...details of recursive panic(s) omitted...]");
+                   last;
+               }
+           }
+           $details = "Output:\n\n" . join ('', map ("$_\n", @output));
+       }
+       print DETAILS $details;
+
+       print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
+           if defined $extra{$test};
+    }
+    close (DETAILS);
+}
+\f
 sub xsystem {
     my ($command, %options) = @_;
     print "$command\n" if $verbose || $options{VERBOSE};
@@ -255,6 +405,14 @@ sub grade_test {
     # If there's a file "$GRADES_DIR/$test.exp", compare its contents
     # against the output.
     # (If both exist, prefer the function.)
+    #
+    # If the test was successful, it returns normally.
+    # If it failed, it invokes `die' with an error message terminated
+    # by a new-line.  The message will be given as an explanation in
+    # the output file tests.out.
+    # (Internal errors will invoke `die' without a terminating
+    # new-line, in which case we detect it and propagate the `die'
+    # upward.)
     my ($grade_func) = "grade_$test";
     $grade_func =~ s/-/_/g;
     if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
@@ -271,9 +429,381 @@ sub grade_test {
     }
     return "ok";
 }
+\f
+# Do final grade.
+# Combines grade.txt, tests.out, review.txt, and details.out,
+# producing grade.out.
+sub compose_final_grade {
+    open (OUT, ">grade.out") or die "grade.out: create: $!\n";
+
+    open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
+    while (<GRADE>) {
+       last if /^\s*$/;
+       print OUT;
+    }
+    close (GRADE);
+    
+    my (@tests) = snarf ("tests.out");
+    my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
+
+    my (@review) = snarf ("review.txt");
+    my ($part_lost) = (0, 0);
+    for (my ($i) = $#review; $i >= 0; $i--) {
+       local ($_) = $review[$i];
+       if (my ($loss) = /^\s*([-+]\d+)/) {
+           $part_lost += $loss;
+       } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
+           my ($got) = $out_of + $part_lost;
+           $got = 0 if $got < 0;
+           $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
+           $part_lost = 0;
+
+           $p_got += $got;
+           $p_pos += $out_of;
+       }
+    }
+    die "Lost points outside a section\n" if $part_lost;
+
+    for (my ($i) = 1; $i <= $#review; $i++) {
+       if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
+           $review[$i] = '-' x (length ($review[$i - 1]));
+       }
+    }
+
+    print OUT "\nOVERALL SCORE\n";
+    print OUT "-------------\n";
+    print OUT "$p_got points out of $p_pos total\n\n";
+
+    print OUT map ("$_\n", @tests), "\n";
+    print OUT map ("$_\n", @review), "\n";
+
+    print OUT "DETAILS\n";
+    print OUT "-------\n\n";
+    print OUT map ("$_\n", snarf ("details.out"));
+}
+\f
+# Clean up our generated files.
+sub clean_dir {
+    # Verify that we're roughly in the correct directory
+    # before we go blasting away files.
+    choose_tarball ();
+
+    # Blow away everything.
+    xsystem ("rm -rf output pintos", VERBOSE => 1);
+    xsystem ("rm -f details.out tests.out", VERBOSE => 1);
+}
+\f
+# Provided a test's output as an array, verifies that it, in general,
+# looks sensible; that is, that there are no PANIC or FAIL messages,
+# that Pintos started up and shut down normally, and so on.
+# Die if something odd found.
+sub verify_common {
+    my (@output) = @_;
+
+    die "No output at all\n" if @output == 0;
+
+    look_for_panic (@output);
+    look_for_fail (@output);
+    look_for_triple_fault (@output);
+    
+    die "Didn't start up properly: no \"Pintos booting\" startup message\n"
+       if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
+    die "Didn't start up properly: no \"Boot complete\" startup message\n"
+       if !grep (/Boot complete/, @output);
+    die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
+        if !grep (/Timer: \d+ ticks/, @output);
+    die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
+       if !grep (/Powering off/, @output);
+}
+
+sub look_for_panic {
+    my (@output) = @_;
+
+    my ($panic) = grep (/PANIC/, @output);
+    return unless defined $panic;
+
+    my ($details) = "Kernel panic:\n  $panic\n";
+
+    my (@stack_line) = grep (/Call stack:/, @output);
+    if (@stack_line != 0) {
+       $details .= "  $stack_line[0]\n\n";
+       $details .= "Translation of backtrace:\n";
+       my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
+
+       my ($A2L);
+       if (`uname -m`
+           =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
+           $A2L = "addr2line";
+       } else {
+           $A2L = "i386-elf-addr2line";
+       }
+       open (A2L, "$A2L -fe pintos/src/filesys/build/kernel.o @addrs|");
+       for (;;) {
+           my ($function, $line);
+           last unless defined ($function = <A2L>);
+           $line = <A2L>;
+           chomp $function;
+           chomp $line;
+           $details .= "  $function ($line)\n";
+       }
+    }
+
+    if ($panic =~ /sec_no < d->capacity/) {
+       $details .= <<EOF;
+\nThis assertion commonly fails when accessing a file via an inode that
+has been closed and freed.  Freeing an inode clears all its sector
+indexes to 0xcccccccc, which is not a valid sector number for disks
+smaller than about 1.6 TB.
+EOF
+       }
+
+    $extra{$test} = $details;
+    die "Kernel panic.  Details at end of file.\n";
+}
+
+sub look_for_fail {
+    my (@output) = @_;
+    
+    my ($failure) = grep (/FAIL/, @output);
+    return unless defined $failure;
+
+    # Eliminate uninteresting header and trailer info if possible.
+    # The `eval' catches the `die' from get_core_output() in the "not
+    # possible" case.
+    eval {
+       my (@core) = get_core_output (@output);
+       $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
+    };
+
+    # Most output lines are prefixed by (test-name).  Eliminate this
+    # from our `die' message for brevity.
+    $failure =~ s/^\([^\)]+\)\s+//;
+    die "$failure.  Details at end of file.\n";
+}
+
+sub look_for_triple_fault {
+    my (@output) = @_;
+
+    return unless grep (/Pintos booting/, @output) > 1;
+
+    my ($details) = <<EOF;
+Pintos spontaneously rebooted during this test.  This is most often
+due to unhandled page faults.  Output from initial boot through the
+first reboot is shown below:
+
+EOF
+
+    my ($i) = 0;
+    local ($_);
+    for (@output) {
+       $details .= "  $_\n";
+       last if /Pintos booting/ && ++$i > 1;
+    }
+    $details{$test} = $details;
+    die "Triple-fault caused spontaneous reboot(s).  "
+       . "Details at end of file.\n";
+}
+
+# Get @output without header or trailer.
+# Die if not possible.
+sub get_core_output {
+    my (@output) = @_;
+
+    my ($first);
+    for ($first = 0; $first <= $#output; $first++) {
+       $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
+    }
+
+    my ($last);
+    for ($last = $#output; $last >= 0; $last--) {
+       $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
+    }
+
+    if ($last < $first) {
+       my ($no_first) = $first > $#output;
+       my ($no_last) = $last < $#output;
+       die "Couldn't locate output.\n";
+    }
+
+    return @output[$first ... $last];
+}
+
+sub canonicalize_exit_codes {
+    my (@output) = @_;
+
+    # Exit codes are supposed to be printed in the form "process: exit(code)"
+    # but people get unfortunately creative with it.
+    for my $i (0...$#output) {
+       local ($_) = $output[$i];
+       
+       my ($process, $code);
+       if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
+           || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
+           || (($process, $code)
+               = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
+           || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
+           || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
+       {
+           # We additionally truncate to 15 character and strip all
+           # but the first word.
+           $process = substr ($process, 0, 15);
+           $process =~ s/\s.*//;
+           $output[$i] = "$process: exit($code)\n";
+       }
+    }
+
+    return @output;
+}
+
+sub strip_exit_codes {
+    return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
+}
+
+sub compare_output {
+    my ($exp, @actual) = @_;
+
+    # Canonicalize output for comparison.
+    @actual = get_core_output (map ("$_\n", @actual));
+    if ($hw eq 'userprog') {
+       @actual = canonicalize_exit_codes (@actual);
+    } elsif ($hw eq 'vm' || $hw eq 'filesys') {
+       @actual = strip_exit_codes (@actual);
+    }
+
+    # There *was* some output, right?
+    die "Program produced no output.\n" if !@actual;
+
+    # Read expected output.
+    my (@exp) = map ("$_\n", snarf ($exp));
+
+    # Pessimistically, start preparation of detailed failure message.
+    my ($details) = "";
+    $details .= "$test actual output:\n";
+    $details .= join ('', map ("  $_", @actual));
+
+    # Set true when we find expected output that matches our actual
+    # output except for some extra actual output (that doesn't seem to
+    # be an error message etc.).
+    my ($fuzzy_match) = 0;
+
+    # Compare actual output against each allowed output.
+    while (@exp != 0) {
+       # Grab one set of allowed output from @exp into @expected.
+       my (@expected);
+       while (@exp != 0) {
+           my ($s) = shift (@exp);
+           last if $s eq "--OR--\n";
+           push (@expected, $s);
+       }
+
+       $details .= "\n$test acceptable output:\n";
+       $details .= join ('', map ("  $_", @expected));
+
+       # Check whether actual and expected match.
+       # If it's a perfect match, return.
+       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) = "";
+       my ($d) = Algorithm::Diff->new (\@expected, \@actual);
+       my ($not_fuzzy_match) = 0;
+       while ($d->Next ()) {
+           my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
+           if ($d->Same ()) {
+               push (@diff, map ("  $_", $d->Items (1)));
+           } else {
+               push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
+               push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
+               if ($d->Items (1)
+                   || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
+                            $d->Items (2))) {
+                   $not_fuzzy_match = 1;
+               }
+           }
+       }
+
+       # If we didn't find anything that means it's not,
+       # it's a fuzzy match.
+       $fuzzy_match = 1 if !$not_fuzzy_match;
+
+       $details .= "Differences in `diff -u' format:\n";
+       $details .= join ('', @diff);
+       $details .= "(This is considered a `fuzzy match'.)\n"
+           if !$not_fuzzy_match;
+    }
+
+    # Failed to match.  Report failure.
+    if ($fuzzy_match) {
+       $details =
+           "This test passed, but with extra, unexpected output.\n"
+           . "Please inspect your code to make sure that it does not\n"
+           . "produce output other than as specified in the project\n"
+           . "description.\n\n"
+           . "$details";
+    } else {
+       $details =
+           "This test failed because its output did not match any\n"
+           . "of the acceptable form(s).\n\n"
+           . "$details";
+    }
+
+    $details{$test} = $details;
+    die "Output differs from expected.  Details at end of file.\n"
+       unless $fuzzy_match;
+}
+\f
+# Reads and returns the contents of the specified file.
+# In an array context, returns the file's contents as an array of
+# lines, omitting new-lines.
+# In a scalar context, returns the file's contents as a single string.
+sub snarf {
+    my ($file) = @_;
+    open (OUTPUT, $file) or die "$file: open: $!\n";
+    my (@lines) = <OUTPUT>;
+    chomp (@lines);
+    close (OUTPUT);
+    return wantarray ? @lines : join ('', map ("$_\n", @lines));
+}
+
+# Returns true if the two specified files are byte-for-byte identical,
+# false otherwise.
+sub files_equal {
+    my ($a, $b) = @_;
+    my ($equal);
+    open (A, "<$a") or die "$a: open: $!\n";
+    open (B, "<$b") or die "$b: open: $!\n";
+    if (-s A != -s B) {
+       $equal = 0;
+    } else {
+       my ($sa, $sb);
+       for (;;) {
+           sysread (A, $sa, 1024);
+           sysread (B, $sb, 1024);
+           $equal = 0, last if $sa ne $sb;
+           $equal = 1, last if $sa eq '';
+       }
+    }
+    close (A);
+    close (B);
+    return $equal;
+}
 
-sub c {
-    print "$test\n";
+# Returns true if the specified file is byte-for-byte identical with
+# the specified string.
+sub file_contains {
+    my ($file, $expected) = @_;
+    open (FILE, "<$file") or die "$file: open: $!\n";
+    my ($actual);
+    sysread (FILE, $actual, -s FILE);
+    my ($equal) = $actual eq $expected;
+    close (FILE);
+    return $equal;
 }
 
 1;
index ad81e4f876508f432e1e8aac13af78714fc66562..a75934570a82ea26adf8e666270e21832ae3e8eb 100644 (file)
@@ -9,7 +9,7 @@ TESTCASES [[/10]]
 DESIGN [[/40]]
 --------------
 
-DESIGNDOC (per problem):
+DESIGNDOC:
   -10 Doesn't discuss page table design
   -10 Doesn't discuss swap design
   -5 Doesn't discuss page replacement algorithm