20 GetOptions ("v|verbose+" => \$verbose,
21 "h|help" => sub { usage (0) },
22 "T|tests=s" => \@TESTS,
23 "c|clean" => sub { set_action ('clean'); },
24 "x|extract" => sub { set_action ('extract'); },
25 "b|build" => sub { set_action ('build'); },
26 "t|test" => sub { set_action ('test'); },
27 "a|assemble" => sub { set_action ('assemble'); })
28 or die "Malformed command line; use --help for help.\n";
29 die "Non-option argument not supported; use --help for help.\n"
31 @TESTS = split(/,/, join (',', @TESTS)) if defined @TESTS;
33 if (!defined $action) {
34 $action = -e 'review.txt' ? 'assemble' : 'test';
39 my ($new_action) = @_;
40 die "actions `$action' and `$new_action' conflict\n"
41 if defined ($action) && $action ne $new_action;
42 $action = $new_action;
48 run-tests, for grading Pintos $hw projects.
50 Invoke from a directory containing a student tarball named by
51 the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz.
55 1. Extracts the source tree into pintos/src and applies patches.
57 2. Builds the source tree. (The threads project modifies and rebuilds
58 the source tree for every test.)
60 3. Runs the tests on the source tree and grades them. Writes
61 "tests.out" with a summary of the test results, and "details.out"
62 with test failure and warning details.
64 4. By hand, copy "review.txt" from the tests directory and use it as a
65 template for grading design documents.
67 5. Assembles "grade.txt", "tests.out", "review.txt", and "tests.out"
68 into "grade.out". This is primarily simple concatenation, but
69 point totals are tallied up as well.
72 -c, --clean Delete test results and temporary files, then exit.
73 -T, --tests=TESTS Run only the specified comma-separated tests.
74 -x, --extract Stop after step 1.
75 -b, --build Stop after step 2.
76 -t, --test Stop after step 3 (default if "review.txt" not present).
77 -a, --assemble Stop after step 5 (default if "review.txt" exists).
78 -v, --verbose Print command lines of subcommands before executing them.
79 -h, --help Print this help message.
86 # Extracts the group's source files into pintos/src,
87 # applies any patches providing in the grading directory,
88 # and installs a default pintos/src/constants.h
90 # Nothing to do if we already have a source tree.
91 return if -d "pintos";
93 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
95 my ($tarball) = choose_tarball ();
98 print "Creating pintos/src...\n";
99 mkdir "pintos" or die "pintos: mkdir: $!\n";
100 mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
102 print "Extracting $tarball into pintos/src...\n";
103 xsystem ("cd pintos/src && tar xzf ../../$tarball",
104 DIE => "extraction failed\n");
106 # Run custom script for this submission, if provided.
108 print "Running fixme.sh...\n";
109 xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
111 print "No fixme.sh, assuming no custom changes needed.\n";
114 # Apply patches from grading directory.
115 # Patches are applied in lexicographic order, so they should
116 # probably be named 00debug.patch, 01bitmap.patch, etc.
117 # Filenames in patches should be in the format pintos/src/...
118 print "Patching...\n";
119 for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
121 ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
122 print "Applying $patch...\n";
123 xsystem ("patch -fs -p0 < $patch",
124 LOG => $stem, DIE => "applying patch $stem failed\n");
127 # Install default pintos/src/constants.h.
128 open (CONSTANTS, ">pintos/src/constants.h")
129 or die "constants.h: create: $!\n";
130 print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
134 # Returns the name of the tarball to extract.
137 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
139 die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
140 if scalar (@tarballs) == 0;
143 # Sort tarballs in order by time.
144 @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
146 print "Multiple tarballs:\n";
147 print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
148 print "Choosing $tarballs[$#tarballs]\n";
150 return $tarballs[$#tarballs];
153 # Extract the date within a tarball name into a string that compares
154 # lexicographically in chronological order.
157 my ($ms, $d, $y, $H, $M, $S) =
158 $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
160 my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
162 return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
168 print "Compiling...\n";
169 xsystem ("cd pintos/src/$hw && make", LOG => "make") eq 'ok'
170 or return "Build error";
173 # Run and grade the tests.
174 sub run_and_grade_tests {
177 my ($result) = get_test_result ();
180 my ($grade) = grade_test ($test);
183 my ($msg) = $result eq 'ok' ? $grade : "$result - $grade";
184 $msg .= " - with warnings"
185 if $grade eq 'ok' && defined $details{$test};
188 $result{$test} = $result;
192 # Write test grades to tests.out.
194 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
200 for (my ($i) = 0; $i <= $#summary; $i++) {
201 local ($_) = $summary[$i];
202 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
203 my ($result) = $result{$test} || "Not tested.";
205 if ($result eq 'ok') {
206 if (!defined $details{$test}) {
207 # Test successful and no warnings.
208 splice (@summary, $i, 1);
211 # Test successful with warnings.
214 splice (@summary, $i + 1, 0,
215 " Test passed with warnings. "
216 . "Details at end of file.");
222 splice (@summary, $i + 1, 0,
223 map (" $_", split ("\n", $result)));
225 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
227 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
228 splice (@summary, $i, 0, " All tests passed.")
229 if $ploss == 0 && !$warnings;
235 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
236 $summary[0] =~ s/\[\[total\]\]/$ts/;
238 open (SUMMARY, ">tests.out");
239 print SUMMARY map ("$_\n", @summary);
243 # Write failure and warning details to details.out.
245 open (DETAILS, ">details.out");
248 next if $result{$test} eq 'ok' && !defined $details{$test};
250 my ($details) = $details{$test};
251 next if !defined ($details) && ! -e "output/$test/run.out";
254 if ($result{$test} ne 'ok') {
255 $banner = "$test failure details";
257 $banner = "$test warnings";
260 print DETAILS "\n" if $n++;
261 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
262 print DETAILS "\n\n";
264 if (!defined $details) {
265 my (@output) = snarf ("output/$test/run.out");
267 # Print only the first in a series of recursing panics.
269 for my $i (0...$#output) {
270 local ($_) = $output[$i];
271 if (/PANIC/ && $panic++ > 0) {
272 @output = @output[0...$i];
274 "[...details of recursive panic(s) omitted...]");
278 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
280 print DETAILS $details;
282 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
283 if defined $extra{$test};
289 my ($command, %options) = @_;
290 print "$command\n" if $verbose || $options{VERBOSE};
292 my ($log) = $options{LOG};
296 local $SIG{ALRM} = sub { die "alarm\n" };
297 alarm $options{TIMEOUT} if defined $options{TIMEOUT};
299 die "fork: $!\n" if !defined $pid;
302 open (STDOUT, ">output/$log.out");
303 open (STDERR, ">output/$log.err");
315 die unless $@ eq "alarm\n"; # propagate unexpected errors
317 for ($i = 0; $i < 10; $i++) {
318 kill ('SIGTERM', $pid);
320 my ($retval) = waitpid ($pid, WNOHANG);
321 last if $retval == $pid || $retval == -1;
322 print "Timed out - Waiting for $pid to die" if $i == 0;
328 if (WIFSIGNALED ($status)) {
329 my ($signal) = WTERMSIG ($status);
330 die "Interrupted\n" if $signal == SIGINT;
331 print "Child terminated with signal $signal\n";
334 my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
335 $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
340 if ($result eq 'error' && defined $options{DIE}) {
341 my ($msg) = $options{DIE};
342 if (defined ($log)) {
344 $msg .= "; see output/$log.err and output/$log.out for details\n";
347 } elsif ($result ne 'error' && defined ($log)) {
348 unlink ("output/$log.err");
354 sub get_test_result {
355 my ($cache_file) = "output/$test/run.result";
356 # Reuse older results if any.
357 if (open (RESULT, "<$cache_file")) {
365 # If there's residue from an earlier test, move it to .old.
366 # If there's already a .old, delete it.
367 xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
368 rename "output/$test", "output/$test.old" or die "rename: $!\n"
369 if -d "output/$test";
371 # Make output directory.
372 mkdir "output/$test";
375 my ($result) = run_test ($test);
377 # Delete any disks in the output directory because they take up
379 unlink (glob ("output/$test/*.dsk"));
381 # Save the results for later.
382 open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
383 print DONE "$result\n";
390 my ($cmd_line, %args) = @_;
391 $args{EXPECT} = 1 unless defined $args{EXPECT};
392 my ($retval) = xsystem ($cmd_line, %args);
393 return 'ok' if $retval eq 'ok';
394 return "Timed out after $args{TIMEOUT} seconds" if $retval eq 'timeout';
395 return 'Error running Bochs' if $retval eq 'error';
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 assemble_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";
541 if ($hw eq 'threads') {
542 $kernel_o = "pintos/src/filesys/build/kernel.o";
544 $kernel_o = "pintos/src/$hw/build/kernel.o";
546 open (A2L, "$A2L -fe $kernel_o @addrs|");
548 my ($function, $line);
549 last unless defined ($function = <A2L>);
553 $details .= " $function ($line)\n";
557 if ($panic =~ /sec_no < d->capacity/) {
559 \nThis assertion commonly fails when accessing a file via an inode that
560 has been closed and freed. Freeing an inode clears all its sector
561 indexes to 0xcccccccc, which is not a valid sector number for disks
562 smaller than about 1.6 TB.
566 $extra{$test} = $details;
567 die "Kernel panic. Details at end of file.\n";
573 my ($failure) = grep (/FAIL/, @output);
574 return unless defined $failure;
576 # Eliminate uninteresting header and trailer info if possible.
577 # The `eval' catches the `die' from get_core_output() in the "not
580 my (@core) = get_core_output (@output);
581 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
584 # Most output lines are prefixed by (test-name). Eliminate this
585 # from our `die' message for brevity.
586 $failure =~ s/^\([^\)]+\)\s+//;
587 die "$failure. Details at end of file.\n";
590 sub look_for_triple_fault {
593 return unless grep (/Pintos booting/, @output) > 1;
595 my ($details) = <<EOF;
596 Pintos spontaneously rebooted during this test. This is most often
597 due to unhandled page faults. Output from initial boot through the
598 first reboot is shown below:
606 last if /Pintos booting/ && ++$i > 1;
608 $details{$test} = $details;
609 die "Triple-fault caused spontaneous reboot(s). "
610 . "Details at end of file.\n";
613 # Get @output without header or trailer.
614 # Die if not possible.
615 sub get_core_output {
619 for ($first = 0; $first <= $#output; $first++) {
620 my ($line) = $output[$first];
622 if ($hw ne 'threads' && $line =~ /^Executing '$test.*':$/)
624 && grep (/^Boot complete.$/, @output[0...$first - 1])
625 && $line =~ /^\s*$/);
629 for ($last = $#output; $last >= 0; $last--) {
630 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
633 if ($last < $first) {
634 my ($no_first) = $first > $#output;
635 my ($no_last) = $last < $#output;
636 die "Couldn't locate output.\n";
639 return @output[$first ... $last];
642 sub canonicalize_exit_codes {
645 # Exit codes are supposed to be printed in the form "process: exit(code)"
646 # but people get unfortunately creative with it.
647 for my $i (0...$#output) {
648 local ($_) = $output[$i];
650 my ($process, $code);
651 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
652 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
653 || (($process, $code)
654 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
655 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
656 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
658 # We additionally truncate to 15 character and strip all
659 # but the first word.
660 $process = substr ($process, 0, 15);
661 $process =~ s/\s.*//;
662 $output[$i] = "$process: exit($code)\n";
669 sub strip_exit_codes {
670 return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
674 my ($exp, @actual) = @_;
676 # Canonicalize output for comparison.
677 @actual = get_core_output (map ("$_\n", @actual));
678 if ($hw eq 'userprog') {
679 @actual = canonicalize_exit_codes (@actual);
680 } elsif ($hw eq 'vm' || $hw eq 'filesys') {
681 @actual = strip_exit_codes (@actual);
684 # There *was* some output, right?
685 die "Program produced no output.\n" if !@actual;
687 # Read expected output.
688 my (@exp) = map ("$_\n", snarf ($exp));
690 # Pessimistically, start preparation of detailed failure message.
692 $details .= "$test actual output:\n";
693 $details .= join ('', map (" $_", @actual));
695 # Set true when we find expected output that matches our actual
696 # output except for some extra actual output (that doesn't seem to
697 # be an error message etc.).
698 my ($fuzzy_match) = 0;
700 # Compare actual output against each allowed output.
702 # Grab one set of allowed output from @exp into @expected.
705 my ($s) = shift (@exp);
706 last if $s eq "--OR--\n";
707 push (@expected, $s);
710 $details .= "\n$test acceptable output:\n";
711 $details .= join ('', map (" $_", @expected));
713 # Check whether actual and expected match.
714 # If it's a perfect match, return.
715 if ($#actual == $#expected) {
717 for (my ($i) = 0; $i <= $#expected; $i++) {
718 $eq = 0 if $actual[$i] ne $expected[$i];
723 # They differ. Output a diff.
725 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
726 my ($not_fuzzy_match) = 0;
727 while ($d->Next ()) {
728 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
730 push (@diff, map (" $_", $d->Items (1)));
732 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
733 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
735 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
737 $not_fuzzy_match = 1;
742 # If we didn't find anything that means it's not,
743 # it's a fuzzy match.
744 $fuzzy_match = 1 if !$not_fuzzy_match;
746 $details .= "Differences in `diff -u' format:\n";
747 $details .= join ('', @diff);
748 $details .= "(This is considered a `fuzzy match'.)\n"
749 if !$not_fuzzy_match;
752 # Failed to match. Report failure.
755 "This test passed, but with extra, unexpected output.\n"
756 . "Please inspect your code to make sure that it does not\n"
757 . "produce output other than as specified in the project\n"
762 "This test failed because its output did not match any\n"
763 . "of the acceptable form(s).\n\n"
767 $details{$test} = $details;
768 die "Output differs from expected. Details at end of file.\n"
772 # Reads and returns the contents of the specified file.
773 # In an array context, returns the file's contents as an array of
774 # lines, omitting new-lines.
775 # In a scalar context, returns the file's contents as a single string.
778 open (OUTPUT, $file) or die "$file: open: $!\n";
779 my (@lines) = <OUTPUT>;
782 return wantarray ? @lines : join ('', map ("$_\n", @lines));
785 # Returns true if the two specified files are byte-for-byte identical,
790 open (A, "<$a") or die "$a: open: $!\n";
791 open (B, "<$b") or die "$b: open: $!\n";
797 sysread (A, $sa, 1024);
798 sysread (B, $sb, 1024);
799 $equal = 0, last if $sa ne $sb;
800 $equal = 1, last if $sa eq '';
808 # Returns true if the specified file is byte-for-byte identical with
809 # the specified string.
811 my ($file, $expected) = @_;
812 open (FILE, "<$file") or die "$file: open: $!\n";
814 sysread (FILE, $actual, -s FILE);
815 my ($equal) = $actual eq $expected;