22 GetOptions ("v|verbose+" => \$verbose,
23 "h|help" => sub { usage (0) },
24 "t|test=s" => \@TESTS,
27 or die "Malformed command line; use --help for help.\n";
28 die "Non-option argument not supported; use --help for help.\n"
34 print "run-tests, for grading Pintos projects.\n\n";
35 print "Invoke from a directory containing a student tarball named by\n";
36 print "the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz.\n";
37 print "In normal usage, no options are needed.\n\n";
38 print "Output is produced in tests.out and details.out.\n\n";
40 print " -c, --clean Remove old output files before starting\n";
41 print " -t, --test=TEST Execute TEST only (allowed multiple times)\n";
42 print " -g, --grade Instead of running tests, compose grade.out\n";
43 print " -v, --verbose Print commands before executing them\n";
44 print " -h, --help Print this help message\n";
50 # Extracts the group's source files into pintos/src,
51 # applies any patches providing in the grading directory,
52 # and installs a default pintos/src/constants.h
54 # Nothing to do if we already have a source tree.
55 return if -d "pintos";
57 my ($tarball) = choose_tarball ();
60 print "Creating pintos/src...\n";
61 mkdir "pintos" or die "pintos: mkdir: $!\n";
62 mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
64 print "Extracting $tarball into pintos/src...\n";
65 xsystem ("cd pintos/src && tar xzf ../../$tarball",
66 DIE => "extraction failed\n");
68 # Run custom script for this submission, if provided.
70 print "Running fixme.sh...\n";
71 xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
73 print "No fixme.sh, assuming no custom changes needed.\n";
76 # Apply patches from grading directory.
77 # Patches are applied in lexicographic order, so they should
78 # probably be named 00-debug.patch, 01-bitmap.patch, etc.
79 # Filenames in patches should be in the format pintos/src/...
80 print "Patching...\n";
81 for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
83 ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
84 print "Applying $patch...\n";
85 xsystem ("patch -fs -p0 < $patch",
86 LOG => $stem, DIE => "applying patch $stem failed\n");
89 # Install default pintos/src/constants.h.
90 open (CONSTANTS, ">pintos/src/constants.h")
91 or die "constants.h: create: $!\n";
92 print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
96 # Returns the name of the tarball to extract.
99 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
101 die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
102 if scalar (@tarballs) == 0;
105 # Sort tarballs in order by time.
106 @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
108 print "Multiple tarballs:";
109 print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
110 print "Choosing $tarballs[$#tarballs]\n";
112 return $tarballs[$#tarballs];
115 # Extract the date within a tarball name into a string that compares
116 # lexicographically in chronological order.
119 my ($ms, $d, $y, $H, $M, $S) =
120 $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
122 my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
124 return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
130 print "Compiling...\n";
131 xsystem ("cd pintos/src/filesys && make", LOG => "make")
132 or return "compile error";
135 # Run and grade the tests.
136 sub run_and_grade_tests {
139 my ($result) = get_test_result ();
140 if ($result eq 'ok') {
141 $result = grade_test ($test);
142 } elsif ($result =~ /^Timed out/) {
143 $result = "$result - " . grade_test ($test);
147 print " - with warnings" if $result eq 'ok' && defined $details{$test};
150 $result{$test} = $result;
154 # Write test grades to tests.out.
156 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
162 for (my ($i) = 0; $i <= $#summary; $i++) {
163 local ($_) = $summary[$i];
164 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
165 my ($result) = $result{$test} || "Not tested.";
167 if ($result eq 'ok') {
168 if (!defined $details{$test}) {
169 # Test successful and no warnings.
170 splice (@summary, $i, 1);
173 # Test successful with warnings.
176 splice (@summary, $i + 1, 0,
177 " Test passed with warnings. "
178 . "Details at end of file.");
184 splice (@summary, $i + 1, 0,
185 map (" $_", split ("\n", $result)));
187 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
189 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
190 splice (@summary, $i, 0, " All tests passed.")
191 if $ploss == 0 && !$warnings;
197 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
198 $summary[0] =~ s/\[\[total\]\]/$ts/;
200 open (SUMMARY, ">tests.out");
201 print SUMMARY map ("$_\n", @summary);
205 # Write failure and warning details to details.out.
207 open (DETAILS, ">details.out");
210 next if $result{$test} eq 'ok' && !defined $details{$test};
212 my ($details) = $details{$test};
213 next if !defined ($details) && ! -e "output/$test/run.out";
216 if ($result{$test} ne 'ok') {
217 $banner = "$test failure details";
219 $banner = "$test warnings";
222 print DETAILS "\n" if $n++;
223 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
224 print DETAILS "\n\n";
226 if (!defined $details) {
227 my (@output) = snarf ("output/$test/run.out");
229 # Print only the first in a series of recursing panics.
231 for my $i (0...$#output) {
232 local ($_) = $output[$i];
233 if (/PANIC/ && $panic++ > 0) {
234 @output = @output[0...$i];
236 "[...details of recursive panic(s) omitted...]");
240 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
242 print DETAILS $details;
244 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
245 if defined $extra{$test};
251 my ($command, %options) = @_;
252 print "$command\n" if $verbose || $options{VERBOSE};
254 my ($log) = $options{LOG};
258 local $SIG{ALRM} = sub { die "alarm\n" };
259 alarm $options{TIMEOUT} if defined $options{TIMEOUT};
261 die "fork: $!\n" if !defined $pid;
264 open (STDOUT, ">output/$log.out");
265 open (STDERR, ">output/$log.err");
277 die unless $@ eq "alarm\n"; # propagate unexpected errors
279 for ($i = 0; $i < 10; $i++) {
280 kill ('SIGTERM', $pid);
282 my ($retval) = waitpid ($pid, WNOHANG);
283 last if $retval == $pid || $retval == -1;
284 print "Timed out - Waiting for $pid to die" if $i == 0;
290 if (WIFSIGNALED ($status)) {
291 my ($signal) = WTERMSIG ($status);
292 die "Interrupted\n" if $signal == SIGINT;
293 print "Child terminated with signal $signal\n";
296 my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
297 $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
302 if ($result eq 'error' && defined $options{DIE}) {
303 my ($msg) = $options{DIE};
304 if (defined ($log)) {
306 $msg .= "; see output/$log.err and output/$log.out for details\n";
309 } elsif ($result ne 'error' && defined ($log)) {
310 unlink ("output/$log.err");
316 sub get_test_result {
317 my ($cache_file) = "output/$test/run.result";
318 # Reuse older results if any.
319 if (open (RESULT, "<$cache_file")) {
327 # If there's residue from an earlier test, move it to .old.
328 # If there's already a .old, delete it.
329 xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
330 rename "output/$test", "output/$test.old" or die "rename: $!\n"
331 if -d "output/$test";
334 my ($result) = run_test ($test);
336 # Save the results for later.
337 open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
338 print DONE "$result\n";
344 # Creates an output directory for the test,
345 # creates all the files needed
347 # Make output directory.
348 mkdir "output/$test";
350 my ($fs_size) = $test ne 'grow-too-big' ? 2 : .25;
351 xsystem ("pintos make-disk output/$test/fs.dsk $fs_size >/dev/null 2>&1",
352 DIE => "failed to create file system disk");
353 xsystem ("pintos make-disk output/$test/swap.dsk 2 >/dev/null 2>&1",
354 DIE => "failed to create swap disk");
356 # Format disk, install test.
357 my ($pintos_base_cmd) =
359 . "--os-disk=pintos/src/filesys/build/os.dsk "
360 . "--fs-disk=output/$test/fs.dsk "
361 . "--swap-disk=output/$test/swap.dsk "
363 unlink ("output/$test/fs.dsk", "output/$test/swap.dsk"),
364 return "format/put error"
365 if xsystem ("$pintos_base_cmd put -f $GRADES_DIR/$test $test",
366 LOG => "$test/put", TIMEOUT => 60, EXPECT => 1) ne 'ok';
369 push (@extra_files, "child-syn-read") if $test eq 'syn-read';
370 push (@extra_files, "child-syn-wrt") if $test eq 'syn-write';
371 push (@extra_files, "child-syn-rw") if $test eq 'syn-rw';
372 for my $fn (@extra_files) {
373 return "format/put error"
374 if xsystem ("$pintos_base_cmd put $GRADES_DIR/$fn $fn",
375 LOG => "$test/put-$fn", TIMEOUT => 60, EXPECT => 1)
381 my ($testargs) = defined ($args{$test}) ? " $args{$test}" : "";
383 xsystem ("$pintos_base_cmd run -q -ex \"$test$testargs\"",
384 LOG => "$test/run", TIMEOUT => $timeout, EXPECT => 1);
386 if ($retval eq 'ok') {
388 } elsif ($retval eq 'timeout') {
389 $result = "Timed out after $timeout seconds";
390 } elsif ($retval eq 'error') {
391 $result = "Bochs error";
395 unlink ("output/$test/fs.dsk", "output/$test/swap.dsk");
402 my (@output) = snarf ("output/$test/run.out");
404 # If there's a function "grade_$test", use it to evaluate the output.
405 # If there's a file "$GRADES_DIR/$test.exp", compare its contents
406 # against the output.
407 # (If both exist, prefer the function.)
409 # If the test was successful, it returns normally.
410 # If it failed, it invokes `die' with an error message terminated
411 # by a new-line. The message will be given as an explanation in
412 # the output file tests.out.
413 # (Internal errors will invoke `die' without a terminating
414 # new-line, in which case we detect it and propagate the `die'
416 my ($grade_func) = "grade_$test";
417 $grade_func =~ s/-/_/g;
418 if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
420 verify_common (@output);
421 compare_output ("$GRADES_DIR/$test.exp", @output);
424 eval "$grade_func (\@output)";
427 die $@ if $@ =~ /at \S+ line \d+$/;
434 # Combines grade.txt, tests.out, review.txt, and details.out,
435 # producing grade.out.
436 sub compose_final_grade {
437 open (OUT, ">grade.out") or die "grade.out: create: $!\n";
439 open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
446 my (@tests) = snarf ("tests.out");
447 my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
449 my (@review) = snarf ("review.txt");
450 my ($part_lost) = (0, 0);
451 for (my ($i) = $#review; $i >= 0; $i--) {
452 local ($_) = $review[$i];
453 if (my ($loss) = /^\s*([-+]\d+)/) {
455 } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
456 my ($got) = $out_of + $part_lost;
457 $got = 0 if $got < 0;
458 $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
465 die "Lost points outside a section\n" if $part_lost;
467 for (my ($i) = 1; $i <= $#review; $i++) {
468 if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
469 $review[$i] = '-' x (length ($review[$i - 1]));
473 print OUT "\nOVERALL SCORE\n";
474 print OUT "-------------\n";
475 print OUT "$p_got points out of $p_pos total\n\n";
477 print OUT map ("$_\n", @tests), "\n";
478 print OUT map ("$_\n", @review), "\n";
480 print OUT "DETAILS\n";
481 print OUT "-------\n\n";
482 print OUT map ("$_\n", snarf ("details.out"));
485 # Clean up our generated files.
487 # Verify that we're roughly in the correct directory
488 # before we go blasting away files.
491 # Blow away everything.
492 xsystem ("rm -rf output pintos", VERBOSE => 1);
493 xsystem ("rm -f details.out tests.out", VERBOSE => 1);
496 # Provided a test's output as an array, verifies that it, in general,
497 # looks sensible; that is, that there are no PANIC or FAIL messages,
498 # that Pintos started up and shut down normally, and so on.
499 # Die if something odd found.
503 die "No output at all\n" if @output == 0;
505 look_for_panic (@output);
506 look_for_fail (@output);
507 look_for_triple_fault (@output);
509 die "Didn't start up properly: no \"Pintos booting\" startup message\n"
510 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
511 die "Didn't start up properly: no \"Boot complete\" startup message\n"
512 if !grep (/Boot complete/, @output);
513 die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
514 if !grep (/Timer: \d+ ticks/, @output);
515 die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
516 if !grep (/Powering off/, @output);
522 my ($panic) = grep (/PANIC/, @output);
523 return unless defined $panic;
525 my ($details) = "Kernel panic:\n $panic\n";
527 my (@stack_line) = grep (/Call stack:/, @output);
528 if (@stack_line != 0) {
529 $details .= " $stack_line[0]\n\n";
530 $details .= "Translation of backtrace:\n";
531 my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
535 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
538 $A2L = "i386-elf-addr2line";
540 open (A2L, "$A2L -fe pintos/src/filesys/build/kernel.o @addrs|");
542 my ($function, $line);
543 last unless defined ($function = <A2L>);
547 $details .= " $function ($line)\n";
551 if ($panic =~ /sec_no < d->capacity/) {
553 \nThis assertion commonly fails when accessing a file via an inode that
554 has been closed and freed. Freeing an inode clears all its sector
555 indexes to 0xcccccccc, which is not a valid sector number for disks
556 smaller than about 1.6 TB.
560 $extra{$test} = $details;
561 die "Kernel panic. Details at end of file.\n";
567 my ($failure) = grep (/FAIL/, @output);
568 return unless defined $failure;
570 # Eliminate uninteresting header and trailer info if possible.
571 # The `eval' catches the `die' from get_core_output() in the "not
574 my (@core) = get_core_output (@output);
575 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
578 # Most output lines are prefixed by (test-name). Eliminate this
579 # from our `die' message for brevity.
580 $failure =~ s/^\([^\)]+\)\s+//;
581 die "$failure. Details at end of file.\n";
584 sub look_for_triple_fault {
587 return unless grep (/Pintos booting/, @output) > 1;
589 my ($details) = <<EOF;
590 Pintos spontaneously rebooted during this test. This is most often
591 due to unhandled page faults. Output from initial boot through the
592 first reboot is shown below:
600 last if /Pintos booting/ && ++$i > 1;
602 $details{$test} = $details;
603 die "Triple-fault caused spontaneous reboot(s). "
604 . "Details at end of file.\n";
607 # Get @output without header or trailer.
608 # Die if not possible.
609 sub get_core_output {
613 for ($first = 0; $first <= $#output; $first++) {
614 $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
618 for ($last = $#output; $last >= 0; $last--) {
619 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
622 if ($last < $first) {
623 my ($no_first) = $first > $#output;
624 my ($no_last) = $last < $#output;
625 die "Couldn't locate output.\n";
628 return @output[$first ... $last];
631 sub canonicalize_exit_codes {
634 # Exit codes are supposed to be printed in the form "process: exit(code)"
635 # but people get unfortunately creative with it.
636 for my $i (0...$#output) {
637 local ($_) = $output[$i];
639 my ($process, $code);
640 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
641 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
642 || (($process, $code)
643 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
644 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
645 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
647 # We additionally truncate to 15 character and strip all
648 # but the first word.
649 $process = substr ($process, 0, 15);
650 $process =~ s/\s.*//;
651 $output[$i] = "$process: exit($code)\n";
658 sub strip_exit_codes {
659 return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
663 my ($exp, @actual) = @_;
665 # Canonicalize output for comparison.
666 @actual = get_core_output (map ("$_\n", @actual));
667 if ($hw eq 'userprog') {
668 @actual = canonicalize_exit_codes (@actual);
669 } elsif ($hw eq 'vm' || $hw eq 'filesys') {
670 @actual = strip_exit_codes (@actual);
673 # There *was* some output, right?
674 die "Program produced no output.\n" if !@actual;
676 # Read expected output.
677 my (@exp) = map ("$_\n", snarf ($exp));
679 # Pessimistically, start preparation of detailed failure message.
681 $details .= "$test actual output:\n";
682 $details .= join ('', map (" $_", @actual));
684 # Set true when we find expected output that matches our actual
685 # output except for some extra actual output (that doesn't seem to
686 # be an error message etc.).
687 my ($fuzzy_match) = 0;
689 # Compare actual output against each allowed output.
691 # Grab one set of allowed output from @exp into @expected.
694 my ($s) = shift (@exp);
695 last if $s eq "--OR--\n";
696 push (@expected, $s);
699 $details .= "\n$test acceptable output:\n";
700 $details .= join ('', map (" $_", @expected));
702 # Check whether actual and expected match.
703 # If it's a perfect match, return.
704 if ($#actual == $#expected) {
706 for (my ($i) = 0; $i <= $#expected; $i++) {
707 $eq = 0 if $actual[$i] ne $expected[$i];
712 # They differ. Output a diff.
714 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
715 my ($not_fuzzy_match) = 0;
716 while ($d->Next ()) {
717 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
719 push (@diff, map (" $_", $d->Items (1)));
721 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
722 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
724 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
726 $not_fuzzy_match = 1;
731 # If we didn't find anything that means it's not,
732 # it's a fuzzy match.
733 $fuzzy_match = 1 if !$not_fuzzy_match;
735 $details .= "Differences in `diff -u' format:\n";
736 $details .= join ('', @diff);
737 $details .= "(This is considered a `fuzzy match'.)\n"
738 if !$not_fuzzy_match;
741 # Failed to match. Report failure.
744 "This test passed, but with extra, unexpected output.\n"
745 . "Please inspect your code to make sure that it does not\n"
746 . "produce output other than as specified in the project\n"
751 "This test failed because its output did not match any\n"
752 . "of the acceptable form(s).\n\n"
756 $details{$test} = $details;
757 die "Output differs from expected. Details at end of file.\n"
761 # Reads and returns the contents of the specified file.
762 # In an array context, returns the file's contents as an array of
763 # lines, omitting new-lines.
764 # In a scalar context, returns the file's contents as a single string.
767 open (OUTPUT, $file) or die "$file: open: $!\n";
768 my (@lines) = <OUTPUT>;
771 return wantarray ? @lines : join ('', map ("$_\n", @lines));
774 # Returns true if the two specified files are byte-for-byte identical,
779 open (A, "<$a") or die "$a: open: $!\n";
780 open (B, "<$b") or die "$b: open: $!\n";
786 sysread (A, $sa, 1024);
787 sysread (B, $sb, 1024);
788 $equal = 0, last if $sa ne $sb;
789 $equal = 1, last if $sa eq '';
797 # Returns true if the specified file is byte-for-byte identical with
798 # the specified string.
800 my ($file, $expected) = @_;
801 open (FILE, "<$file") or die "$file: open: $!\n";
803 sysread (FILE, $actual, -s FILE);
804 my ($equal) = $actual eq $expected;