16 use Getopt::Long qw(:config no_ignore_case);
19 # We execute lots of subprocesses.
20 # Without this, our stdout output can get flushed multiple times,
21 # which is harmless but looks bizarre.
25 my ($do_regex, $no_regex);
26 GetOptions ("v|verbose+" => \$verbose,
27 "h|help" => sub { usage (0) },
28 "d|do-tests=s" => \$do_regex,
29 "n|no-tests=s" => \$no_regex,
30 "c|clean" => sub { set_action ('clean'); },
31 "x|extract" => sub { set_action ('extract'); },
32 "b|build" => sub { set_action ('build'); },
33 "t|test" => sub { set_action ('test'); },
34 "a|assemble" => sub { set_action ('assemble'); })
35 or die "Malformed command line; use --help for help.\n";
36 die "Non-option arguments not supported; use --help for help.\n"
38 @TESTS = split(/,/, join (',', @TESTS)) if defined @TESTS;
40 if (!defined $action) {
41 $action = -e 'review.txt' ? 'assemble' : 'test';
44 my (@default_tests) = @_;
45 @TESTS = @default_tests;
46 @TESTS = grep (/$do_regex/, @TESTS) if defined $do_regex;
47 @TESTS = grep (!/$no_regex/, @TESTS) if defined $no_regex;
51 my ($new_action) = @_;
52 die "actions `$action' and `$new_action' conflict\n"
53 if defined ($action) && $action ne $new_action;
54 $action = $new_action;
60 run-tests, for grading Pintos $hw projects.
62 Invoke from a directory containing a student tarball named by
63 the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz.
67 1. Extracts the source tree into pintos/src and applies patches.
69 2. Builds the source tree. (The threads project modifies and rebuilds
70 the source tree for every test.)
72 3. Runs the tests on the source tree and grades them. Writes
73 "tests.out" with a summary of the test results, and "details.out"
74 with test failure and warning details.
76 4. By hand, copy "review.txt" from the tests directory and use it as a
77 template for grading design documents.
79 5. Assembles "grade.txt", "tests.out", "review.txt", and "tests.out"
80 into "grade.out". This is primarily simple concatenation, but
81 point totals are tallied up as well.
84 -c, --clean Delete test results and temporary files, then exit.
85 -d, --do-tests=RE Run only tests that match the given regular expression.
86 -n, --no-tests=RE Do not run tests that match the given regular expression.
87 -x, --extract Stop after step 1.
88 -b, --build Stop after step 2.
89 -t, --test Stop after step 3 (default if "review.txt" not present).
90 -a, --assemble Stop after step 5 (default if "review.txt" exists).
91 -v, --verbose Print command lines of subcommands before executing them.
92 -h, --help Print this help message.
99 # Extracts the group's source files into pintos/src,
100 # applies any patches providing in the grading directory,
101 # and installs a default pintos/src/constants.h
102 sub extract_sources {
103 # Make sure the output dir exists.
104 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
106 # Nothing else to do if we already have a source tree.
107 return if -d "pintos";
109 my ($tarball) = choose_tarball ();
112 print "Creating pintos/src...\n";
113 mkdir "pintos" or die "pintos: mkdir: $!\n";
114 mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
116 print "Extracting $tarball into pintos/src...\n";
117 xsystem ("cd pintos/src && tar xzf ../../$tarball",
118 DIE => "extraction failed\n");
120 # Run custom script for this submission, if provided.
122 print "Running fixme.sh...\n";
123 xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
125 print "No fixme.sh, assuming no custom changes needed.\n";
128 # Apply patches from grading directory.
129 # Patches are applied in lexicographic order, so they should
130 # probably be named 00debug.patch, 01bitmap.patch, etc.
131 # Filenames in patches should be in the format pintos/src/...
132 print "Patching...\n";
133 for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
135 ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
136 print "Applying $patch...\n";
137 xsystem ("patch -fs -p0 < $patch",
138 LOG => $stem, DIE => "applying patch $stem failed\n");
141 # Install default pintos/src/constants.h.
142 open (CONSTANTS, ">pintos/src/constants.h")
143 or die "constants.h: create: $!\n";
144 print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
148 # Returns the name of the tarball to extract.
151 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
153 die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
154 if scalar (@tarballs) == 0;
157 # Sort tarballs in order by time.
158 @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
160 print "Multiple tarballs:\n";
161 print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
162 print "Choosing $tarballs[$#tarballs]\n";
164 return $tarballs[$#tarballs];
167 # Extract the date within a tarball name into a string that compares
168 # lexicographically in chronological order.
171 my ($ms, $d, $y, $H, $M, $S) =
172 $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
174 my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
176 return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
182 print "Compiling...\n";
183 xsystem ("cd pintos/src/$hw && make", LOG => "make") eq 'ok'
184 or return "Build error";
187 # Run and grade the tests.
188 sub run_and_grade_tests {
191 my ($result) = get_test_result ();
194 my ($grade) = grade_test ($test);
197 my ($msg) = $result eq 'ok' ? $grade : "$result - $grade";
198 $msg .= " - with warnings"
199 if $grade eq 'ok' && defined $details{$test};
202 $result{$test} = $grade;
206 # Write test grades to tests.out.
208 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
214 for (my ($i) = 0; $i <= $#summary; $i++) {
215 local ($_) = $summary[$i];
216 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
217 my ($result) = $result{$test} || "Not tested.";
219 if ($result eq 'ok') {
220 if (!defined $details{$test}) {
221 # Test successful and no warnings.
222 splice (@summary, $i, 1);
225 # Test successful with warnings.
228 splice (@summary, $i + 1, 0,
229 " Test passed with warnings. "
230 . "Details at end of file.");
236 splice (@summary, $i + 1, 0,
237 map (" $_", split ("\n", $result)));
239 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
241 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
242 splice (@summary, $i, 0, " All tests passed.")
243 if $ploss == 0 && !$warnings;
249 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
250 $summary[0] =~ s/\[\[total\]\]/$ts/;
252 open (SUMMARY, ">tests.out");
253 print SUMMARY map ("$_\n", @summary);
257 # Write failure and warning details to details.out.
259 open (DETAILS, ">details.out");
262 next if $result{$test} eq 'ok' && !defined $details{$test};
264 my ($details) = $details{$test};
265 next if !defined ($details) && ! -e "output/$test/run.out";
268 if ($result{$test} ne 'ok') {
269 $banner = "$test failure details";
271 $banner = "$test warnings";
274 print DETAILS "\n" if $n++;
275 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
276 print DETAILS "\n\n";
278 if (!defined $details) {
279 my (@output) = snarf ("output/$test/run.out");
281 # Print only the first in a series of recursing panics.
283 for my $i (0...$#output) {
284 local ($_) = $output[$i];
285 if (/PANIC/ && $panic++ > 0) {
286 @output = @output[0...$i];
288 "[...details of recursive panic(s) omitted...]");
292 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
294 print DETAILS $details;
296 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
297 if defined $extra{$test};
303 my ($command, %options) = @_;
304 print "$command\n" if $verbose || $options{VERBOSE};
306 my ($log) = $options{LOG};
310 local $SIG{ALRM} = sub { die "alarm\n" };
311 alarm $options{TIMEOUT} if defined $options{TIMEOUT};
313 die "fork: $!\n" if !defined $pid;
316 open (STDOUT, ">output/$log.out");
317 open (STDERR, ">output/$log.err");
329 die unless $@ eq "alarm\n"; # propagate unexpected errors
331 for ($i = 0; $i < 10; $i++) {
332 kill ('SIGTERM', $pid);
334 my ($retval) = waitpid ($pid, WNOHANG);
335 last if $retval == $pid || $retval == -1;
336 print "Timed out - Waiting for $pid to die" if $i == 0;
342 if (WIFSIGNALED ($status)) {
343 my ($signal) = WTERMSIG ($status);
344 die "Interrupted\n" if $signal == SIGINT;
345 print "Child terminated with signal $signal\n";
348 my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
349 $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
354 if ($result eq 'error' && defined $options{DIE}) {
355 my ($msg) = $options{DIE};
356 if (defined ($log)) {
358 $msg .= "; see output/$log.err and output/$log.out for details\n";
361 } elsif ($result ne 'error' && defined ($log)) {
362 unlink ("output/$log.err");
368 sub get_test_result {
369 my ($cache_file) = "output/$test/run.result";
370 # Reuse older results if any.
371 if (open (RESULT, "<$cache_file")) {
379 # If there's residue from an earlier test, move it to .old.
380 # If there's already a .old, delete it.
381 xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
382 rename "output/$test", "output/$test.old" or die "rename: $!\n"
383 if -d "output/$test";
385 # Make output directory.
386 mkdir "output/$test";
389 my ($result) = run_test ($test);
391 # Delete any disks in the output directory because they take up
393 unlink (glob ("output/$test/*.dsk"));
395 # Save the results for later.
396 open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
397 print DONE "$result\n";
404 my ($cmd_line, %args) = @_;
405 $args{EXPECT} = 1 unless defined $args{EXPECT};
406 my ($retval) = xsystem ($cmd_line, %args);
407 return 'ok' if $retval eq 'ok';
408 return "Timed out after $args{TIMEOUT} seconds" if $retval eq 'timeout';
409 return 'Error running Bochs' if $retval eq 'error';
416 my ($outfile) = "output/$test/run.out";
417 die "$outfile: missing test output file (make failed?)" if ! -e $outfile;
418 my (@output) = snarf ($outfile);
420 # If there's a function "grade_$test", use it to evaluate the output.
421 # If there's a file "$GRADES_DIR/$test.exp", compare its contents
422 # against the output.
423 # (If both exist, prefer the function.)
425 # If the test was successful, it returns normally.
426 # If it failed, it invokes `die' with an error message terminated
427 # by a new-line. The message will be given as an explanation in
428 # the output file tests.out.
429 # (Internal errors will invoke `die' without a terminating
430 # new-line, in which case we detect it and propagate the `die'
432 my ($grade_func) = "grade_$test";
433 $grade_func =~ s/-/_/g;
434 if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
436 verify_common (@output);
437 compare_output ("$GRADES_DIR/$test.exp", @output);
440 eval "$grade_func (\@output)";
443 die $@ if $@ =~ /at \S+ line \d+$/;
450 # Combines grade.txt, tests.out, review.txt, and details.out,
451 # producing grade.out.
452 sub assemble_final_grade {
453 open (OUT, ">grade.out") or die "grade.out: create: $!\n";
455 open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
462 my (@tests) = snarf ("tests.out");
463 my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
465 my (@review) = snarf ("review.txt");
466 my ($part_lost) = (0, 0);
467 for (my ($i) = $#review; $i >= 0; $i--) {
468 local ($_) = $review[$i];
469 if (my ($loss) = /^\s*([-+]\d+)/) {
471 } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
472 my ($got) = $out_of + $part_lost;
473 $got = 0 if $got < 0;
474 $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
481 die "Lost points outside a section\n" if $part_lost;
483 for (my ($i) = 1; $i <= $#review; $i++) {
484 if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
485 $review[$i] = '-' x (length ($review[$i - 1]));
489 print OUT "\nOVERALL SCORE\n";
490 print OUT "-------------\n";
491 print OUT "$p_got points out of $p_pos total\n\n";
493 print OUT map ("$_\n", @tests), "\n";
494 print OUT map ("$_\n", @review), "\n";
496 print OUT "DETAILS\n";
497 print OUT "-------\n\n";
498 print OUT map ("$_\n", snarf ("details.out"));
501 # Clean up our generated files.
503 # Verify that we're roughly in the correct directory
504 # before we go blasting away files.
507 # Blow away everything.
508 xsystem ("rm -rf output pintos", VERBOSE => 1);
509 xsystem ("rm -f details.out tests.out", VERBOSE => 1);
512 # Provided a test's output as an array, verifies that it, in general,
513 # looks sensible; that is, that there are no PANIC or FAIL messages,
514 # that Pintos started up and shut down normally, and so on.
515 # Die if something odd found.
519 die "No output at all\n" if @output == 0;
521 look_for_panic (@output);
522 look_for_fail (@output);
523 look_for_triple_fault (@output);
525 die "Didn't start up properly: no \"Pintos booting\" startup message\n"
526 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
527 die "Didn't start up properly: no \"Boot complete\" startup message\n"
528 if !grep (/Boot complete/, @output);
529 die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
530 if !grep (/Timer: \d+ ticks/, @output);
531 die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
532 if !grep (/Powering off/, @output);
538 my ($panic) = grep (/PANIC/, @output);
539 return unless defined $panic;
541 my ($details) = "Kernel panic:\n $panic\n";
543 my (@stack_line) = grep (/Call stack:/, @output);
544 if (@stack_line != 0) {
545 $details .= " $stack_line[0]\n\n";
546 $details .= "Translation of backtrace:\n";
547 my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
551 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
554 $A2L = "i386-elf-addr2line";
557 if ($hw eq 'threads') {
558 $kernel_o = "output/$test/kernel.o";
560 $kernel_o = "pintos/src/$hw/build/kernel.o";
562 open (A2L, "$A2L -fe $kernel_o @addrs|");
564 my ($function, $line);
565 last unless defined ($function = <A2L>);
569 $details .= " $function ($line)\n";
573 if ($panic =~ /sec_no < d->capacity/) {
575 \nThis assertion commonly fails when accessing a file via an inode that
576 has been closed and freed. Freeing an inode clears all its sector
577 indexes to 0xcccccccc, which is not a valid sector number for disks
578 smaller than about 1.6 TB.
582 $extra{$test} = $details;
583 die "Kernel panic. Details at end of file.\n";
589 my ($failure) = grep (/FAIL/, @output);
590 return unless defined $failure;
592 # Eliminate uninteresting header and trailer info if possible.
593 # The `eval' catches the `die' from get_core_output() in the "not
596 my (@core) = get_core_output (@output);
597 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
600 # Most output lines are prefixed by (test-name). Eliminate this
601 # from our `die' message for brevity.
602 $failure =~ s/^\([^\)]+\)\s+//;
603 die "$failure. Details at end of file.\n";
606 sub look_for_triple_fault {
609 return unless grep (/Pintos booting/, @output) > 1;
611 my ($details) = <<EOF;
612 Pintos spontaneously rebooted during this test. This is most often
613 due to unhandled page faults. Output from initial boot through the
614 first reboot is shown below:
622 last if /Pintos booting/ && ++$i > 1;
624 $details{$test} = $details;
625 die "Triple-fault caused spontaneous reboot(s). "
626 . "Details at end of file.\n";
629 # Get @output without header or trailer.
630 # Die if not possible.
631 sub get_core_output {
635 for ($first = 0; $first <= $#output; $first++) {
636 my ($line) = $output[$first];
638 if ($hw ne 'threads' && $line =~ /^Executing '$test.*':$/)
640 && grep (/^Boot complete.$/, @output[0...$first - 1])
641 && $line =~ /^\s*$/);
645 for ($last = $#output; $last >= 0; $last--) {
646 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
649 if ($last < $first) {
650 my ($no_first) = $first > $#output;
651 my ($no_last) = $last < $#output;
652 die "Couldn't locate output.\n";
655 return @output[$first ... $last];
658 sub canonicalize_exit_codes {
661 # Exit codes are supposed to be printed in the form "process: exit(code)"
662 # but people get unfortunately creative with it.
663 for my $i (0...$#output) {
664 local ($_) = $output[$i];
666 my ($process, $code);
667 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
668 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
669 || (($process, $code)
670 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
671 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
672 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
674 # We additionally truncate to 15 character and strip all
675 # but the first word.
676 $process = substr ($process, 0, 15);
677 $process =~ s/\s.*//;
678 $output[$i] = "$process: exit($code)\n";
685 sub strip_exit_codes {
686 return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
690 my ($exp, @actual) = @_;
692 # Canonicalize output for comparison.
693 @actual = get_core_output (map ("$_\n", @actual));
694 if ($hw eq 'userprog') {
695 @actual = canonicalize_exit_codes (@actual);
696 } elsif ($hw eq 'vm' || $hw eq 'filesys') {
697 @actual = strip_exit_codes (@actual);
700 # There *was* some output, right?
701 die "Program produced no output.\n" if !@actual;
703 # Read expected output.
704 my (@exp) = map ("$_\n", snarf ($exp));
706 # Pessimistically, start preparation of detailed failure message.
708 $details .= "$test actual output:\n";
709 $details .= join ('', map (" $_", @actual));
711 # Set true when we find expected output that matches our actual
712 # output except for some extra actual output (that doesn't seem to
713 # be an error message etc.).
714 my ($fuzzy_match) = 0;
716 # Compare actual output against each allowed output.
718 # Grab one set of allowed output from @exp into @expected.
721 my ($s) = shift (@exp);
722 last if $s eq "--OR--\n";
723 push (@expected, $s);
726 $details .= "\n$test acceptable output:\n";
727 $details .= join ('', map (" $_", @expected));
729 # Check whether actual and expected match.
730 # If it's a perfect match, return.
731 if ($#actual == $#expected) {
733 for (my ($i) = 0; $i <= $#expected; $i++) {
734 $eq = 0 if $actual[$i] ne $expected[$i];
739 # They differ. Output a diff.
741 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
742 my ($not_fuzzy_match) = 0;
743 while ($d->Next ()) {
744 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
746 push (@diff, map (" $_", $d->Items (1)));
748 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
749 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
751 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
753 $not_fuzzy_match = 1;
758 # If we didn't find anything that means it's not,
759 # it's a fuzzy match.
760 $fuzzy_match = 1 if !$not_fuzzy_match;
762 $details .= "Differences in `diff -u' format:\n";
763 $details .= join ('', @diff);
764 $details .= "(This is considered a `fuzzy match'.)\n"
765 if !$not_fuzzy_match;
768 # Failed to match. Report failure.
771 "This test passed, but with extra, unexpected output.\n"
772 . "Please inspect your code to make sure that it does not\n"
773 . "produce output other than as specified in the project\n"
778 "This test failed because its output did not match any\n"
779 . "of the acceptable form(s).\n\n"
783 $details{$test} = $details;
784 die "Output differs from expected. Details at end of file.\n"
788 # Reads and returns the contents of the specified file.
789 # In an array context, returns the file's contents as an array of
790 # lines, omitting new-lines.
791 # In a scalar context, returns the file's contents as a single string.
794 open (OUTPUT, $file) or die "$file: open: $!\n";
795 my (@lines) = <OUTPUT>;
798 return wantarray ? @lines : join ('', map ("$_\n", @lines));
801 # Returns true if the two specified files are byte-for-byte identical,
806 open (A, "<$a") or die "$a: open: $!\n";
807 open (B, "<$b") or die "$b: open: $!\n";
813 sysread (A, $sa, 1024);
814 sysread (B, $sb, 1024);
815 $equal = 0, last if $sa ne $sb;
816 $equal = 1, last if $sa eq '';
824 # Returns true if the specified file is byte-for-byte identical with
825 # the specified string.
827 my ($file, $expected) = @_;
828 open (FILE, "<$file") or die "$file: open: $!\n";
830 sysread (FILE, $actual, -s FILE);
831 my ($equal) = $actual eq $expected;