20 GetOptions ("v|verbose+" => \$verbose,
21 "h|help" => sub { usage (0) },
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 arguments 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 --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 # Make sure the output dir exists.
91 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
93 # Nothing else to do if we already have a source tree.
94 return if -d "pintos";
96 my ($tarball) = choose_tarball ();
99 print "Creating pintos/src...\n";
100 mkdir "pintos" or die "pintos: mkdir: $!\n";
101 mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
103 print "Extracting $tarball into pintos/src...\n";
104 xsystem ("cd pintos/src && tar xzf ../../$tarball",
105 DIE => "extraction failed\n");
107 # Run custom script for this submission, if provided.
109 print "Running fixme.sh...\n";
110 xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
112 print "No fixme.sh, assuming no custom changes needed.\n";
115 # Apply patches from grading directory.
116 # Patches are applied in lexicographic order, so they should
117 # probably be named 00debug.patch, 01bitmap.patch, etc.
118 # Filenames in patches should be in the format pintos/src/...
119 print "Patching...\n";
120 for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
122 ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
123 print "Applying $patch...\n";
124 xsystem ("patch -fs -p0 < $patch",
125 LOG => $stem, DIE => "applying patch $stem failed\n");
128 # Install default pintos/src/constants.h.
129 open (CONSTANTS, ">pintos/src/constants.h")
130 or die "constants.h: create: $!\n";
131 print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
135 # Returns the name of the tarball to extract.
138 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
140 die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
141 if scalar (@tarballs) == 0;
144 # Sort tarballs in order by time.
145 @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
147 print "Multiple tarballs:\n";
148 print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
149 print "Choosing $tarballs[$#tarballs]\n";
151 return $tarballs[$#tarballs];
154 # Extract the date within a tarball name into a string that compares
155 # lexicographically in chronological order.
158 my ($ms, $d, $y, $H, $M, $S) =
159 $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
161 my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
163 return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
169 print "Compiling...\n";
170 xsystem ("cd pintos/src/$hw && make", LOG => "make") eq 'ok'
171 or return "Build error";
174 # Run and grade the tests.
175 sub run_and_grade_tests {
178 my ($result) = get_test_result ();
181 my ($grade) = grade_test ($test);
184 my ($msg) = $result eq 'ok' ? $grade : "$result - $grade";
185 $msg .= " - with warnings"
186 if $grade eq 'ok' && defined $details{$test};
189 $result{$test} = $grade;
193 # Write test grades to tests.out.
195 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
201 for (my ($i) = 0; $i <= $#summary; $i++) {
202 local ($_) = $summary[$i];
203 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
204 my ($result) = $result{$test} || "Not tested.";
206 if ($result eq 'ok') {
207 if (!defined $details{$test}) {
208 # Test successful and no warnings.
209 splice (@summary, $i, 1);
212 # Test successful with warnings.
215 splice (@summary, $i + 1, 0,
216 " Test passed with warnings. "
217 . "Details at end of file.");
223 splice (@summary, $i + 1, 0,
224 map (" $_", split ("\n", $result)));
226 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
228 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
229 splice (@summary, $i, 0, " All tests passed.")
230 if $ploss == 0 && !$warnings;
236 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
237 $summary[0] =~ s/\[\[total\]\]/$ts/;
239 open (SUMMARY, ">tests.out");
240 print SUMMARY map ("$_\n", @summary);
244 # Write failure and warning details to details.out.
246 open (DETAILS, ">details.out");
249 next if $result{$test} eq 'ok' && !defined $details{$test};
251 my ($details) = $details{$test};
252 next if !defined ($details) && ! -e "output/$test/run.out";
255 if ($result{$test} ne 'ok') {
256 $banner = "$test failure details";
258 $banner = "$test warnings";
261 print DETAILS "\n" if $n++;
262 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
263 print DETAILS "\n\n";
265 if (!defined $details) {
266 my (@output) = snarf ("output/$test/run.out");
268 # Print only the first in a series of recursing panics.
270 for my $i (0...$#output) {
271 local ($_) = $output[$i];
272 if (/PANIC/ && $panic++ > 0) {
273 @output = @output[0...$i];
275 "[...details of recursive panic(s) omitted...]");
279 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
281 print DETAILS $details;
283 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
284 if defined $extra{$test};
290 my ($command, %options) = @_;
291 print "$command\n" if $verbose || $options{VERBOSE};
293 my ($log) = $options{LOG};
297 local $SIG{ALRM} = sub { die "alarm\n" };
298 alarm $options{TIMEOUT} if defined $options{TIMEOUT};
300 die "fork: $!\n" if !defined $pid;
303 open (STDOUT, ">output/$log.out");
304 open (STDERR, ">output/$log.err");
316 die unless $@ eq "alarm\n"; # propagate unexpected errors
318 for ($i = 0; $i < 10; $i++) {
319 kill ('SIGTERM', $pid);
321 my ($retval) = waitpid ($pid, WNOHANG);
322 last if $retval == $pid || $retval == -1;
323 print "Timed out - Waiting for $pid to die" if $i == 0;
329 if (WIFSIGNALED ($status)) {
330 my ($signal) = WTERMSIG ($status);
331 die "Interrupted\n" if $signal == SIGINT;
332 print "Child terminated with signal $signal\n";
335 my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
336 $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
341 if ($result eq 'error' && defined $options{DIE}) {
342 my ($msg) = $options{DIE};
343 if (defined ($log)) {
345 $msg .= "; see output/$log.err and output/$log.out for details\n";
348 } elsif ($result ne 'error' && defined ($log)) {
349 unlink ("output/$log.err");
355 sub get_test_result {
356 my ($cache_file) = "output/$test/run.result";
357 # Reuse older results if any.
358 if (open (RESULT, "<$cache_file")) {
366 # If there's residue from an earlier test, move it to .old.
367 # If there's already a .old, delete it.
368 xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
369 rename "output/$test", "output/$test.old" or die "rename: $!\n"
370 if -d "output/$test";
372 # Make output directory.
373 mkdir "output/$test";
376 my ($result) = run_test ($test);
378 # Delete any disks in the output directory because they take up
380 unlink (glob ("output/$test/*.dsk"));
382 # Save the results for later.
383 open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
384 print DONE "$result\n";
391 my ($cmd_line, %args) = @_;
392 $args{EXPECT} = 1 unless defined $args{EXPECT};
393 my ($retval) = xsystem ($cmd_line, %args);
394 return 'ok' if $retval eq 'ok';
395 return "Timed out after $args{TIMEOUT} seconds" if $retval eq 'timeout';
396 return 'Error running Bochs' if $retval eq 'error';
403 my (@output) = snarf ("output/$test/run.out");
405 # If there's a function "grade_$test", use it to evaluate the output.
406 # If there's a file "$GRADES_DIR/$test.exp", compare its contents
407 # against the output.
408 # (If both exist, prefer the function.)
410 # If the test was successful, it returns normally.
411 # If it failed, it invokes `die' with an error message terminated
412 # by a new-line. The message will be given as an explanation in
413 # the output file tests.out.
414 # (Internal errors will invoke `die' without a terminating
415 # new-line, in which case we detect it and propagate the `die'
417 my ($grade_func) = "grade_$test";
418 $grade_func =~ s/-/_/g;
419 if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
421 verify_common (@output);
422 compare_output ("$GRADES_DIR/$test.exp", @output);
425 eval "$grade_func (\@output)";
428 die $@ if $@ =~ /at \S+ line \d+$/;
435 # Combines grade.txt, tests.out, review.txt, and details.out,
436 # producing grade.out.
437 sub assemble_final_grade {
438 open (OUT, ">grade.out") or die "grade.out: create: $!\n";
440 open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
447 my (@tests) = snarf ("tests.out");
448 my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
450 my (@review) = snarf ("review.txt");
451 my ($part_lost) = (0, 0);
452 for (my ($i) = $#review; $i >= 0; $i--) {
453 local ($_) = $review[$i];
454 if (my ($loss) = /^\s*([-+]\d+)/) {
456 } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
457 my ($got) = $out_of + $part_lost;
458 $got = 0 if $got < 0;
459 $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
466 die "Lost points outside a section\n" if $part_lost;
468 for (my ($i) = 1; $i <= $#review; $i++) {
469 if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
470 $review[$i] = '-' x (length ($review[$i - 1]));
474 print OUT "\nOVERALL SCORE\n";
475 print OUT "-------------\n";
476 print OUT "$p_got points out of $p_pos total\n\n";
478 print OUT map ("$_\n", @tests), "\n";
479 print OUT map ("$_\n", @review), "\n";
481 print OUT "DETAILS\n";
482 print OUT "-------\n\n";
483 print OUT map ("$_\n", snarf ("details.out"));
486 # Clean up our generated files.
488 # Verify that we're roughly in the correct directory
489 # before we go blasting away files.
492 # Blow away everything.
493 xsystem ("rm -rf output pintos", VERBOSE => 1);
494 xsystem ("rm -f details.out tests.out", VERBOSE => 1);
497 # Provided a test's output as an array, verifies that it, in general,
498 # looks sensible; that is, that there are no PANIC or FAIL messages,
499 # that Pintos started up and shut down normally, and so on.
500 # Die if something odd found.
504 die "No output at all\n" if @output == 0;
506 look_for_panic (@output);
507 look_for_fail (@output);
508 look_for_triple_fault (@output);
510 die "Didn't start up properly: no \"Pintos booting\" startup message\n"
511 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
512 die "Didn't start up properly: no \"Boot complete\" startup message\n"
513 if !grep (/Boot complete/, @output);
514 die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
515 if !grep (/Timer: \d+ ticks/, @output);
516 die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
517 if !grep (/Powering off/, @output);
523 my ($panic) = grep (/PANIC/, @output);
524 return unless defined $panic;
526 my ($details) = "Kernel panic:\n $panic\n";
528 my (@stack_line) = grep (/Call stack:/, @output);
529 if (@stack_line != 0) {
530 $details .= " $stack_line[0]\n\n";
531 $details .= "Translation of backtrace:\n";
532 my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
536 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
539 $A2L = "i386-elf-addr2line";
542 if ($hw eq 'threads') {
543 $kernel_o = "output/$test/kernel.o";
545 $kernel_o = "pintos/src/$hw/build/kernel.o";
547 open (A2L, "$A2L -fe $kernel_o @addrs|");
549 my ($function, $line);
550 last unless defined ($function = <A2L>);
554 $details .= " $function ($line)\n";
558 if ($panic =~ /sec_no < d->capacity/) {
560 \nThis assertion commonly fails when accessing a file via an inode that
561 has been closed and freed. Freeing an inode clears all its sector
562 indexes to 0xcccccccc, which is not a valid sector number for disks
563 smaller than about 1.6 TB.
567 $extra{$test} = $details;
568 die "Kernel panic. Details at end of file.\n";
574 my ($failure) = grep (/FAIL/, @output);
575 return unless defined $failure;
577 # Eliminate uninteresting header and trailer info if possible.
578 # The `eval' catches the `die' from get_core_output() in the "not
581 my (@core) = get_core_output (@output);
582 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
585 # Most output lines are prefixed by (test-name). Eliminate this
586 # from our `die' message for brevity.
587 $failure =~ s/^\([^\)]+\)\s+//;
588 die "$failure. Details at end of file.\n";
591 sub look_for_triple_fault {
594 return unless grep (/Pintos booting/, @output) > 1;
596 my ($details) = <<EOF;
597 Pintos spontaneously rebooted during this test. This is most often
598 due to unhandled page faults. Output from initial boot through the
599 first reboot is shown below:
607 last if /Pintos booting/ && ++$i > 1;
609 $details{$test} = $details;
610 die "Triple-fault caused spontaneous reboot(s). "
611 . "Details at end of file.\n";
614 # Get @output without header or trailer.
615 # Die if not possible.
616 sub get_core_output {
620 for ($first = 0; $first <= $#output; $first++) {
621 my ($line) = $output[$first];
623 if ($hw ne 'threads' && $line =~ /^Executing '$test.*':$/)
625 && grep (/^Boot complete.$/, @output[0...$first - 1])
626 && $line =~ /^\s*$/);
630 for ($last = $#output; $last >= 0; $last--) {
631 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
634 if ($last < $first) {
635 my ($no_first) = $first > $#output;
636 my ($no_last) = $last < $#output;
637 die "Couldn't locate output.\n";
640 return @output[$first ... $last];
643 sub canonicalize_exit_codes {
646 # Exit codes are supposed to be printed in the form "process: exit(code)"
647 # but people get unfortunately creative with it.
648 for my $i (0...$#output) {
649 local ($_) = $output[$i];
651 my ($process, $code);
652 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
653 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
654 || (($process, $code)
655 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
656 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
657 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
659 # We additionally truncate to 15 character and strip all
660 # but the first word.
661 $process = substr ($process, 0, 15);
662 $process =~ s/\s.*//;
663 $output[$i] = "$process: exit($code)\n";
670 sub strip_exit_codes {
671 return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
675 my ($exp, @actual) = @_;
677 # Canonicalize output for comparison.
678 @actual = get_core_output (map ("$_\n", @actual));
679 if ($hw eq 'userprog') {
680 @actual = canonicalize_exit_codes (@actual);
681 } elsif ($hw eq 'vm' || $hw eq 'filesys') {
682 @actual = strip_exit_codes (@actual);
685 # There *was* some output, right?
686 die "Program produced no output.\n" if !@actual;
688 # Read expected output.
689 my (@exp) = map ("$_\n", snarf ($exp));
691 # Pessimistically, start preparation of detailed failure message.
693 $details .= "$test actual output:\n";
694 $details .= join ('', map (" $_", @actual));
696 # Set true when we find expected output that matches our actual
697 # output except for some extra actual output (that doesn't seem to
698 # be an error message etc.).
699 my ($fuzzy_match) = 0;
701 # Compare actual output against each allowed output.
703 # Grab one set of allowed output from @exp into @expected.
706 my ($s) = shift (@exp);
707 last if $s eq "--OR--\n";
708 push (@expected, $s);
711 $details .= "\n$test acceptable output:\n";
712 $details .= join ('', map (" $_", @expected));
714 # Check whether actual and expected match.
715 # If it's a perfect match, return.
716 if ($#actual == $#expected) {
718 for (my ($i) = 0; $i <= $#expected; $i++) {
719 $eq = 0 if $actual[$i] ne $expected[$i];
724 # They differ. Output a diff.
726 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
727 my ($not_fuzzy_match) = 0;
728 while ($d->Next ()) {
729 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
731 push (@diff, map (" $_", $d->Items (1)));
733 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
734 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
736 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
738 $not_fuzzy_match = 1;
743 # If we didn't find anything that means it's not,
744 # it's a fuzzy match.
745 $fuzzy_match = 1 if !$not_fuzzy_match;
747 $details .= "Differences in `diff -u' format:\n";
748 $details .= join ('', @diff);
749 $details .= "(This is considered a `fuzzy match'.)\n"
750 if !$not_fuzzy_match;
753 # Failed to match. Report failure.
756 "This test passed, but with extra, unexpected output.\n"
757 . "Please inspect your code to make sure that it does not\n"
758 . "produce output other than as specified in the project\n"
763 "This test failed because its output did not match any\n"
764 . "of the acceptable form(s).\n\n"
768 $details{$test} = $details;
769 die "Output differs from expected. Details at end of file.\n"
773 # Reads and returns the contents of the specified file.
774 # In an array context, returns the file's contents as an array of
775 # lines, omitting new-lines.
776 # In a scalar context, returns the file's contents as a single string.
779 open (OUTPUT, $file) or die "$file: open: $!\n";
780 my (@lines) = <OUTPUT>;
783 return wantarray ? @lines : join ('', map ("$_\n", @lines));
786 # Returns true if the two specified files are byte-for-byte identical,
791 open (A, "<$a") or die "$a: open: $!\n";
792 open (B, "<$b") or die "$b: open: $!\n";
798 sysread (A, $sa, 1024);
799 sysread (B, $sb, 1024);
800 $equal = 0, last if $sa ne $sb;
801 $equal = 1, last if $sa eq '';
809 # Returns true if the specified file is byte-for-byte identical with
810 # the specified string.
812 my ($file, $expected) = @_;
813 open (FILE, "<$file") or die "$file: open: $!\n";
815 sysread (FILE, $actual, -s FILE);
816 my ($equal) = $actual eq $expected;