Final updates for grading project 1.
[pintos-anon] / grading / threads / run-tests
index 75d4a704b8a05a55d8730288123949302c4f5c15..94fd802938c394cca40528004ba40f51dd9a769f 100755 (executable)
@@ -9,11 +9,13 @@ use Getopt::Long;
 our ($VERBOSE) = 0;    # Verbosity of output
 our (@TESTS);          # Tests to run.
 my ($clean) = 0;
+my ($grade) = 0;
 
 GetOptions ("v|verbose+" => \$VERBOSE,
            "h|help" => sub { usage (0) },
            "t|test=s" => \@TESTS,
-           "c|clean" => \$clean)
+           "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;
@@ -28,6 +30,7 @@ sub usage {
     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;
@@ -43,6 +46,58 @@ sub usage {
          "mlfqs-on", "mlfqs-off")
     unless @TESTS > 0;
 
+# 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;
+}
+
 # Find the directory that contains the grading files.
 our ($GRADES_DIR);
 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
@@ -83,6 +138,10 @@ for $test (@TESTS) {
     $result{$test} = $result;
 }
 
+# MLFQS takes results from mlfqs-on and mlfqs-off.
+grade_mlfqs_speedup ();
+grade_mlfqs_priority ();
+
 # Write output.
 write_grades ();
 write_details ();
@@ -143,7 +202,6 @@ sub test_constants {
 
 sub run_test {
     my ($test) = @_;
-    return "ok" if -f "output/$test/done";
 
     # Reuse older results if any.
     if (open (DONE, "<output/$test/done")) {
@@ -184,6 +242,17 @@ sub really_run_test {
        close (CONSTANTS);
     }
 
+    # Changes devices/timer.c if necessary.
+    my ($new_time_slice) = $test eq 'priority-fifo' ? 100 : 1;
+    my (@timer) = snarf ("pintos/src/devices/timer.c");
+    if (!grep (/^\#define TIME_SLICE $new_time_slice$/, @timer)) {
+       @timer = grep (!/^\#define TIME_SLICE/, @timer);
+       unshift (@timer, "#define TIME_SLICE $new_time_slice");
+       open (TIMER, ">pintos/src/devices/timer.c");
+       print TIMER map ("$_\n", @timer);
+       close (TIMER);
+    }
+
     # Copy in the new test.c and delete enough files to ensure a full rebuild.
     my ($src) = test_source ($test);
     xsystem ("cp $src pintos/src/threads/test.c", DIE => "cp failed\n");
@@ -372,41 +441,98 @@ sub grade_priority_fifo {
 sub grade_mlfqs_on {
     my (@output) = @_;
     verify_common (@output);
-    mlfqs_stats (@output);
+    our (@mlfqs_on_stats) = mlfqs_stats (@output);
 }
 
 sub grade_mlfqs_off {
     my (@output) = @_;
     verify_common (@output);
-    mlfqs_stats (@output);
+    our (@mlfqs_off_stats) = mlfqs_stats (@output);
+}
+
+sub grade_mlfqs_speedup {
+    our (@mlfqs_off_stats);
+    our (@mlfqs_on_stats);
+    eval {
+       check_mlfqs ();
+       my ($off_ticks) = $mlfqs_off_stats[1];
+       my ($on_ticks) = $mlfqs_on_stats[1];
+       die "$off_ticks ticks without MLFQS, $on_ticks with MLFQS\n"
+           if $on_ticks >= $off_ticks;
+       die "ok\n";
+    };
+    chomp $@;
+    $result{'mlfqs-speedup'} = $@;
+}
+
+sub grade_mlfqs_priority {
+    our (@mlfqs_off_stats);
+    our (@mlfqs_on_stats);
+    eval {
+       check_mlfqs () if !defined (@mlfqs_on_stats);
+       for my $cat qw (CPU IO MIX) {
+           die "Priority changed away from PRI_DEFAULT (29) without MLFQS\n"
+               if $mlfqs_off_stats[0]{$cat}{MIN} != 29
+               || $mlfqs_off_stats[0]{$cat}{MAX} != 29;
+           die "Minimum priority never changed from PRI_DEFAULT (29) "
+               . "with MLFQS\n"
+               if $mlfqs_on_stats[0]{$cat}{MIN} == 29;
+           die "Maximum priority never changed from PRI_DEFAULT (29) "
+               . "with MLFQS\n"
+               if $mlfqs_on_stats[0]{$cat}{MAX} == 29;
+       }
+       die "ok\n";
+    };
+    chomp $@;
+    $result{'mlfqs-priority'} = $@;
+}
+
+sub check_mlfqs {
+    our (@mlfqs_off_stats);
+    our (@mlfqs_on_stats);
+    die "p1-4 didn't finish with MLFQS on or off\n"
+       if !defined (@mlfqs_off_stats) && !defined (@mlfqs_on_stats);
+    die "p1-4 didn't finish with MLFQS on\n"
+       if !defined (@mlfqs_on_stats);
+    die "p1-4 didn't finish with MLFQS off\n"
+       if !defined (@mlfqs_off_stats);
 }
 
 sub mlfqs_stats {
     my (@output) = @_;
-    my (%stats) = ("io" => {}, "cpu" => {}, "mix" => {});
-    my (%map) = ("CPU intensive" => "cpu",
-                "IO intensive" => "io",
-                "Alternating IO/CPU" => "mix");
+    my (%stats) = (CPU => {}, IO => {}, MIX => {});
+    my (%map) = ("CPU intensive" => 'CPU',
+                "IO intensive" => 'IO',
+                "Alternating IO/CPU" => 'MIX');
+    my (%rmap) = reverse %map;
+    my ($ticks);
     local ($_);
     foreach (@output) {
+       $ticks = $1 if /Timer: (\d+) ticks/;
        my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
        my ($t) = $map{$thread} or next;
        
        my ($s) = $stats{$t};
-       $$s{"n"}++;
-       $$s{"sum"} += $pri;
-       $$s{"sum2"} += $pri * $pri;
-       $$s{"min"} = $pri if !defined ($$s{"min"}) || $pri < $$s{"min"};
-       $$s{"max"} = $pri if !defined ($$s{"max"}) || $pri > $$s{"max"};
+       $$s{N}++;
+       $$s{SUM} += $pri;
+       $$s{SUM2} += $pri * $pri;
+       $$s{MIN} = $pri if !defined ($$s{MIN}) || $pri < $$s{MIN};
+       $$s{MAX} = $pri if !defined ($$s{MAX}) || $pri > $$s{MAX};
     }
 
-    my ($details) = "";
-    for my $t (keys %stats) {
-       my ($s) = $stats{$t};
-       $details .= "$t: n=$$s{'n'}, min=$$s{'min'}, max=$$s{'max'}, avg=" . int ($$s{'sum'} / $$s{'n'}) . "\n";
+    my (%expect_n) = (CPU => 5000, IO => 1000, MIX => 12000);
+    for my $cat (values (%map)) {
+       my ($s) = $stats{$cat};
+       die "$rmap{$cat} printed $$s{N} times, not $expect_n{$cat}\n"
+           if $$s{N} != $expect_n{$cat};
+       die "$rmap{$cat} priority dropped to $$s{MIN}, below PRI_MIN (0)\n"
+           if $$s{MIN} < 0;
+       die "$rmap{$cat} priority rose to $$s{MAX}, above PRI_MAX (59)\n"
+           if $$s{MAX} > 59;
+       $$s{MEAN} = $$s{SUM} / $$s{N};
     }
-    $details{$test} = $details;
-    die "MLFQS\n";
+
+    return (\%stats, $ticks);
 }
 \f
 sub verify_common {
@@ -481,43 +607,25 @@ sub compare_output {
     }
 
     # They differ.  Output a diff.
-    my ($diff) = "";
+    my (@diff) = "";
     my ($d) = Algorithm::Diff->new (\@expected, \@actual);
-    $d->Base (1);
     while ($d->Next ()) {
        my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
        if ($d->Same ()) {
-           if ($af != $al) {
-               $diff .= "Actual lines $af...$al match expected lines "
-                   . "$ef...$el.\n";
-           } else {
-               $diff .= "Actual line $af matches expected line $ef.\n";
-           }
+           push (@diff, map ("  $_", $d->Items (1)));
        } else {
-           my (@i1) = $d->Items (1);
-           my (@i2) = $d->Items (2);
-           if (!@i1) {
-               $diff .= "Extra or misplaced line(s) $af...$al "
-                   . "in actual output:\n";
-               $diff .= number_lines ($af, \@i2);
-           } elsif (!$d->Items (2)) {
-               $diff .= "Expected line(s) $ef...$el missing or misplaced:\n";
-               $diff .= number_lines ($ef, \@i1);
-           } else {
-               $diff .= "The following expected line(s) $ef...$el:\n";
-               $diff .= number_lines ($ef, \@i1);
-               $diff .= "became actual line(s) $af...$al:\n";
-               $diff .= number_lines ($af, \@i2);
-           }
+           push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
+           push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
        }
     }
 
     my ($details) = "";
-    $details .= "$test actual output (line numbers added):\n";
-    $details .= number_lines (1, \@actual);
-    $details .= "\n$test expected output (line numbers added):\n";
-    $details .= number_lines (1, \@expected);
-    $details .= "\n$diff\n";
+    $details .= "$test actual output:\n";
+    $details .= join ('', map ("  $_", @actual));
+    $details .= "\n$test expected output:\n";
+    $details .= join ('', map ("  $_", @expected));
+    $details .= "\nOutput differences in `diff -u' format:\n";
+    $details .= join ('', @diff) . "\n";
     $details{$test} = $details;
     die "Output differs from expected.  Details at end of file.\n";
 }