pintos-os.org Git - pintos-anon/blob - grading/filesys/run-tests

   1 #! /usr/bin/perl
   2
   3 # Find the directory that contains the grading files.
   4 use vars qw($GRADES_DIR);
   5
   6 # Add our Perl library directory to the include path.
   7 BEGIN {
   8     ($GRADES_DIR = $0) =~ s#/[^/]+$##;
   9     -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
  10     unshift @INC, "$GRADES_DIR/../lib";
  11 }
  12
  13 use warnings;
  14 use strict;
  15 use POSIX;
  16 use Algorithm::Diff;
  17 use Getopt::Long;
  18 use Pintos::Grading;
  19
  20 our ($test);
  21 our ($verbose) = 0;     # Verbosity of output
  22 our (@TESTS);           # Tests to run.
  23 my ($clean) = 0;
  24 my ($grade) = 0;
  25
  26 GetOptions ("v|verbose+" => \$verbose,
  27             "h|help" => sub { usage (0) },
  28             "t|test=s" => \@TESTS,
  29             "c|clean" => \$clean,
  30             "g|grade" => \$grade)
  31     or die "Malformed command line; use --help for help.\n";
  32 die "Non-option argument not supported; use --help for help.\n"
  33     if @ARGV > 0;
  34
  35 sub usage {
  36     my ($exitcode) = @_;
  37     print "run-tests, for grading Pintos multiprogramming projects.\n\n";
  38     print "Invoke from a directory containing a student tarball named by\n";
  39     print "the submit script, e.g. username.Oct.12.04.20.04.09.tar.gz.\n";
  40     print "In normal usage, no options are needed.\n\n";
  41     print "Output is produced in tests.out and details.out.\n\n";
  42     print "Options:\n";
  43     print "  -c, --clean     Remove old output files before starting\n";
  44     print "  -t, --test=TEST Execute TEST only (allowed multiple times)\n";
  45     print "  -g, --grade     Instead of running tests, compose grade.out\n";
  46     print "  -v, --verbose   Print commands before executing them\n";
  47     print "  -h, --help      Print this help message\n";
  48     exit $exitcode;
  49 }
  50
  51 # Default set of tests.
  52 @TESTS = qw (sm-create sm-full sm-seq-block sm-seq-random sm-random
  53
  54              grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell
  55              grow-sparse grow-too-big grow-root-sm grow-root-lg grow-dir-lg
  56              grow-two-files
  57
  58              dir-mkdir dir-rmdir dir-mk-vine dir-rm-vine dir-mk-tree
  59              dir-rm-tree dir-lsdir dir-rm-cwd dir-rm-cwd-cd
  60              dir-rm-parent dir-rm-root dir-over-file dir-under-file
  61              dir-empty-name dir-open
  62
  63              syn-remove syn-read syn-write syn-rw
  64              ) unless @TESTS > 0;
  65
  66 our (%args);
  67
  68 # Handle final grade mode.
  69 if ($grade) {
  70     open (OUT, ">grade.out") or die "grade.out: create: $!\n";
  71
  72     open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
  73     while (<GRADE>) {
  74         last if /^\s*$/;
  75         print OUT;
  76     }
  77     close (GRADE);
  78
  79     my (@tests) = snarf ("tests.out");
  80     my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
  81
  82     my (@review) = snarf ("review.txt");
  83     my ($part_lost) = (0, 0);
  84     for (my ($i) = $#review; $i >= 0; $i--) {
  85         local ($_) = $review[$i];
  86         if (my ($loss) = /^\s*([-+]\d+)/) {
  87             $part_lost += $loss;
  88         } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
  89             my ($got) = $out_of + $part_lost;
  90             $got = 0 if $got < 0;
  91             $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
  92             $part_lost = 0;
  93
  94             $p_got += $got;
  95             $p_pos += $out_of;
  96         }
  97     }
  98     die "Lost points outside a section\n" if $part_lost;
  99
 100     for (my ($i) = 1; $i <= $#review; $i++) {
 101         if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
 102             $review[$i] = '-' x (length ($review[$i - 1]));
 103         }
 104     }
 105
 106     print OUT "\nOVERALL SCORE\n";
 107     print OUT "-------------\n";
 108     print OUT "$p_got points out of $p_pos total\n\n";
 109
 110     print OUT map ("$_\n", @tests), "\n";
 111     print OUT map ("$_\n", @review), "\n";
 112
 113     print OUT "DETAILS\n";
 114     print OUT "-------\n\n";
 115     print OUT map ("$_\n", snarf ("details.out"));
 116
 117     exit 0;
 118 }
 119
 120 if ($clean) {
 121     # Verify that we're roughly in the correct directory
 122     # before we go blasting away files.
 123     choose_tarball ();
 124
 125     xsystem ("rm -rf output pintos", VERBOSE => 1);
 126     xsystem ("rm -f details.out tests.out", VERBOSE => 1);
 127 }
 128
 129 # Create output directory, if it doesn't already exist.
 130 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
 131
 132 # Extract submission.
 133 obtain_sources ();
 134
 135 # Compile submission.
 136 compile ();
 137
 138 # Verify that the proper directory was submitted.
 139 -d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
 140
 141 # Run and grade the tests.
 142 our %result;
 143 our %details;
 144 our %extra;
 145 for $test (@TESTS) {
 146     print "$test: ";
 147     my ($result) = get_test_result ();
 148     if ($result eq 'ok') {
 149         $result = grade_test ($test);
 150     } elsif ($result =~ /^Timed out/) {
 151         $result = "$result - " . grade_test ($test);
 152     }
 153     chomp ($result);
 154     print "$result";
 155     print " - with warnings" if $result eq 'ok' && defined $details{$test};
 156     print "\n";
 157
 158     $result{$test} = $result;
 159 }
 160
 161 # Write output.
 162 write_grades ();
 163 write_details ();
 164 \f
 165 \f
 166 sub grade_process_death {
 167     my ($proc_name, @output) = @_;
 168
 169     verify_common (@output);
 170     @output = get_core_output (@output);
 171     die "First line of output is not `($proc_name) begin' message.\n"
 172         if $output[0] ne "($proc_name) begin";
 173     die "Output contains `FAIL' message.\n"
 174         if grep (/FAIL/, @output);
 175     die "Output contains spurious ($proc_name) message.\n"
 176         if grep (/\($proc_name\)/, @output) > 1;
 177 }
 178
 179 sub grade_pt_bad_addr {
 180     grade_process_death ('pt-bad-addr', @_);
 181 }
 182
 183 sub grade_pt_write_code {
 184     grade_process_death ('pt-write-code', @_);
 185 }
 186
 187 sub grade_mmap_unmap {
 188     grade_process_death ('mmap-unmap', @_);
 189 }
 190 \f
 191 sub verify_common {
 192     my (@output) = @_;
 193
 194     my (@assertion) = grep (/PANIC/, @output);
 195     if (@assertion != 0) {
 196         my ($details) = "Kernel panic:\n  $assertion[0]\n";
 197
 198         my (@stack_line) = grep (/Call stack:/, @output);
 199         if (@stack_line != 0) {
 200             $details .= "  $stack_line[0]\n\n";
 201             $details .= "Translation of backtrace:\n";
 202             my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
 203
 204             my ($A2L);
 205             if (`uname -m`
 206                 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
 207                 $A2L = "addr2line";
 208             } else {
 209                 $A2L = "i386-elf-addr2line";
 210             }
 211             open (A2L, "$A2L -fe pintos/src/filesys/build/kernel.o @addrs|");
 212             for (;;) {
 213                 my ($function, $line);
 214                 last unless defined ($function = <A2L>);
 215                 $line = <A2L>;
 216                 chomp $function;
 217                 chomp $line;
 218                 $details .= "  $function ($line)\n";
 219             }
 220         }
 221
 222         if ($assertion[0] =~ /sec_no < d->capacity/) {
 223             $details .= <<EOF;
 224 \nThis assertion commonly fails when accessing a file via
 225 an inode that has been closed and freed.  Freeing an inode
 226 clears all its sector indexes to 0xcccccccc, which is not
 227 a valid sector number for disks smaller than about 1.6 TB.
 228 EOF
 229         }
 230
 231         $extra{$test} = $details;
 232         die "Kernel panic.  Details at end of file.\n"
 233     }
 234
 235     my (@failure) = grep (/FAIL/, @output);
 236     if (@failure != 0) {
 237         eval {
 238             my (@core) = get_core_output (@output);
 239             $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
 240         };
 241         my ($failure) = $failure[0];
 242         $failure =~ s/^\([^)]+\)\s+//;
 243         die "Failed with message \"$failure\"\n";
 244     }
 245
 246     if (grep (/Pintos booting/, @output) > 1) {
 247         my ($details);
 248
 249         $details = "Pintos spontaneously rebooted during this test.\n";
 250         $details .= "This is most often due to unhandled page faults.\n";
 251         $details .= "Here's the output from the initial boot through the\n";
 252         $details .= "first reboot:\n\n";
 253
 254         my ($i) = 0;
 255         local ($_);
 256         for (@output) {
 257             $details .= "  $_\n";
 258             last if /Pintos booting/ && ++$i > 1;
 259         }
 260         $details{$test} = $details;
 261         die "Triple-fault caused spontaneous reboot(s).  "
 262             . "Details at end of file.\n";
 263     }
 264
 265     die "No output at all\n" if @output == 0;
 266     die "Didn't start up properly: no \"Pintos booting\" startup message\n"
 267         if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
 268     die "Didn't start up properly: no \"Boot complete\" startup message\n"
 269         if !grep (/Boot complete/, @output);
 270     die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
 271         if !grep (/Timer: \d+ ticks/, @output);
 272     die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
 273         if !grep (/Powering off/, @output);
 274 }
 275
 276 # Get @output without header or trailer.
 277 sub get_core_output {
 278     my (@output) = @_;
 279
 280     my ($first);
 281     for ($first = 0; $first <= $#output; $first++) {
 282         $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
 283     }
 284
 285     my ($last);
 286     for ($last = $#output; $last >= 0; $last--) {
 287         $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
 288     }
 289
 290     if ($last < $first) {
 291         my ($no_first) = $first > $#output;
 292         my ($no_last) = $last < $#output;
 293         die "Couldn't locate output.\n";
 294     }
 295
 296     return @output[$first ... $last];
 297 }
 298
 299 sub fix_exit_codes {
 300     my (@output) = @_;
 301
 302     # Remove lines that look like exit codes.
 303     # Exit codes are supposed to be printed in the form "process: exit(code)"
 304     # but people get unfortunately creative with it.
 305     for (my ($i) = 0; $i <= $#output; $i++) {
 306         local ($_) = $output[$i];
 307
 308         my ($process, $code);
 309         if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
 310             || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
 311             || (($process, $code)
 312                 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
 313             || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
 314             || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/)
 315             ) {
 316             splice (@output, $i, 1);
 317             $i--;
 318         }
 319     }
 320
 321     return @output;
 322 }
 323
 324 sub compare_output {
 325     my ($exp, @actual) = @_;
 326     @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual)));
 327     die "Program produced no output.\n" if !@actual;
 328
 329     my ($details) = "";
 330     $details .= "$test actual output:\n";
 331     $details .= join ('', map ("  $_", @actual));
 332
 333     my (@exp) = map ("$_\n", snarf ($exp));
 334
 335     my ($fuzzy_match) = 0;
 336     while (@exp != 0) {
 337         my (@expected);
 338         while (@exp != 0) {
 339             my ($s) = shift (@exp);
 340             last if $s eq "--OR--\n";
 341             push (@expected, $s);
 342         }
 343
 344         $details .= "\n$test acceptable output:\n";
 345         $details .= join ('', map ("  $_", @expected));
 346
 347         # Check whether they're the same.
 348         if ($#actual == $#expected) {
 349             my ($eq) = 1;
 350             for (my ($i) = 0; $i <= $#expected; $i++) {
 351                 $eq = 0 if $actual[$i] ne $expected[$i];
 352             }
 353             return if $eq;
 354         }
 355
 356         # They differ.  Output a diff.
 357         my (@diff) = "";
 358         my ($d) = Algorithm::Diff->new (\@expected, \@actual);
 359         my ($not_fuzzy_match) = 0;
 360         while ($d->Next ()) {
 361             my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
 362             if ($d->Same ()) {
 363                 push (@diff, map ("  $_", $d->Items (1)));
 364             } else {
 365                 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
 366                 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
 367                 if ($d->Items (1)
 368                     || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
 369                              $d->Items (2))) {
 370                     $not_fuzzy_match = 1;
 371                 }
 372             }
 373         }
 374         $fuzzy_match = 1 if !$not_fuzzy_match;
 375
 376         $details .= "Differences in `diff -u' format:\n";
 377         $details .= join ('', @diff);
 378         $details .= "(This is considered a `fuzzy match'.)\n"
 379             if !$not_fuzzy_match;
 380     }
 381
 382     if ($fuzzy_match) {
 383         $details =
 384             "This test passed, but with extra, unexpected output.\n"
 385             . "Please inspect your code to make sure that it does not\n"
 386             . "produce output other than as specified in the project\n"
 387             . "description.\n\n"
 388             . "$details";
 389     } else {
 390         $details =
 391             "This test failed because its output did not match any\n"
 392             . "of the acceptable form(s).\n\n"
 393             . "$details";
 394     }
 395
 396     $details{$test} = $details;
 397     die "Output differs from expected.  Details at end of file.\n"
 398         unless $fuzzy_match;
 399 }
 400 \f
 401 sub write_grades {
 402     my (@summary) = snarf ("$GRADES_DIR/tests.txt");
 403
 404     my ($ploss) = 0;
 405     my ($tloss) = 0;
 406     my ($total) = 0;
 407     my ($warnings) = 0;
 408     for (my ($i) = 0; $i <= $#summary; $i++) {
 409         local ($_) = $summary[$i];
 410         if (my ($loss, $test) = /^  -(\d+) ([-a-zA-Z0-9]+):/) {
 411             my ($result) = $result{$test} || "Not tested.";
 412
 413             if ($result eq 'ok') {
 414                 if (!defined $details{$test}) {
 415                     # Test successful and no warnings.
 416                     splice (@summary, $i, 1);
 417                     $i--;
 418                 } else {
 419                     # Test successful with warnings.
 420                     s/-(\d+) //;
 421                     $summary[$i] = $_;
 422                     splice (@summary, $i + 1, 0,
 423                             "     Test passed with warnings.  "
 424                             . "Details at end of file.");
 425                     $warnings++;
 426                 }
 427             } else {
 428                 $ploss += $loss;
 429                 $tloss += $loss;
 430                 splice (@summary, $i + 1, 0,
 431                         map ("     $_", split ("\n", $result)));
 432             }
 433         } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
 434             $total += $ptotal;
 435             $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
 436             splice (@summary, $i, 0, "  All tests passed.")
 437                 if $ploss == 0 && !$warnings;
 438             $ploss = 0;
 439             $warnings = 0;
 440             $i++;
 441         }
 442     }
 443     my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
 444     $summary[0] =~ s/\[\[total\]\]/$ts/;
 445
 446     open (SUMMARY, ">tests.out");
 447     print SUMMARY map ("$_\n", @summary);
 448     close (SUMMARY);
 449 }
 450
 451 sub write_details {
 452     open (DETAILS, ">details.out");
 453     my ($n) = 0;
 454     for $test (@TESTS) {
 455         next if $result{$test} eq 'ok' && !defined $details{$test};
 456
 457         my ($details) = $details{$test};
 458         next if !defined ($details) && ! -e "output/$test/run.out";
 459
 460         my ($banner);
 461         if ($result{$test} ne 'ok') {
 462             $banner = "$test failure details";
 463         } else {
 464             $banner = "$test warnings";
 465         }
 466
 467         print DETAILS "\n" if $n++;
 468         print DETAILS "--- $banner ", '-' x (50 - length ($banner));
 469         print DETAILS "\n\n";
 470
 471         if (!defined $details) {
 472             my (@output) = snarf ("output/$test/run.out");
 473
 474             # Print only the first in a series of recursing panics.
 475             my ($panic) = 0;
 476             for my $i (0...$#output) {
 477                 local ($_) = $output[$i];
 478                 if (/PANIC/ && $panic++ > 0) {
 479                     @output = @output[0...$i];
 480                     push (@output,
 481                           "[...details of recursive panic(s) omitted...]");
 482                     last;
 483                 }
 484             }
 485             $details = "Output:\n\n" . join ('', map ("$_\n", @output));
 486         }
 487         print DETAILS $details;
 488
 489         print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
 490             if defined $extra{$test};
 491     }
 492     close (DETAILS);
 493
 494 }
 495 \f
 496 sub snarf {
 497     my ($file) = @_;
 498     open (OUTPUT, $file) or die "$file: open: $!\n";
 499     my (@lines) = <OUTPUT>;
 500     chomp (@lines);
 501     close (OUTPUT);
 502     return wantarray ? @lines : join ('', map ("$_\n", @lines));
 503 }
 504
 505 sub files_equal {
 506     my ($a, $b) = @_;
 507     my ($equal);
 508     open (A, "<$a") or die "$a: open: $!\n";
 509     open (B, "<$b") or die "$b: open: $!\n";
 510     if (-s A != -s B) {
 511         $equal = 0;
 512     } else {
 513         my ($sa, $sb);
 514         for (;;) {
 515             sysread (A, $sa, 1024);
 516             sysread (B, $sb, 1024);
 517             $equal = 0, last if $sa ne $sb;
 518             $equal = 1, last if $sa eq '';
 519         }
 520     }
 521     close (A);
 522     close (B);
 523     return $equal;
 524 }
 525
 526 sub file_contains {
 527     my ($file, $expected) = @_;
 528     open (FILE, "<$file") or die "$file: open: $!\n";
 529     my ($actual);
 530     sysread (FILE, $actual, -s FILE);
 531     my ($equal) = $actual eq $expected;
 532     close (FILE);
 533     return $equal;
 534 }
 535
 536 sub number_lines {
 537     my ($ln, $lines) = @_;
 538     my ($out);
 539     for my $line (@$lines) {
 540         chomp $line;
 541         $out .= sprintf "%4d  %s\n", $ln++, $line;
 542     }
 543     return $out;
 544 }