16 use Getopt::Long qw(:config no_ignore_case);
20 my ($do_regex, $no_regex);
21 GetOptions ("v|verbose+" => \$verbose,
22 "h|help" => sub { usage (0) },
23 "d|do-tests=s" => \$do_regex,
24 "n|no-tests=s" => \$no_regex,
25 "c|clean" => sub { set_action ('clean'); },
26 "x|extract" => sub { set_action ('extract'); },
27 "b|build" => sub { set_action ('build'); },
28 "t|test" => sub { set_action ('test'); },
29 "a|assemble" => sub { set_action ('assemble'); })
30 or die "Malformed command line; use --help for help.\n";
31 die "Non-option arguments not supported; use --help for help.\n"
33 @TESTS = split(/,/, join (',', @TESTS)) if defined @TESTS;
35 if (!defined $action) {
36 $action = -e 'review.txt' ? 'assemble' : 'test';
39 my (@default_tests) = @_;
40 @TESTS = @default_tests;
41 @TESTS = grep (/$do_regex/, @TESTS) if defined $do_regex;
42 @TESTS = grep (!/$no_regex/, @TESTS) if defined $no_regex;
46 my ($new_action) = @_;
47 die "actions `$action' and `$new_action' conflict\n"
48 if defined ($action) && $action ne $new_action;
49 $action = $new_action;
55 run-tests, for grading Pintos $hw projects.
57 Invoke from a directory containing a student tarball named by
58 the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz.
62 1. Extracts the source tree into pintos/src and applies patches.
64 2. Builds the source tree. (The threads project modifies and rebuilds
65 the source tree for every test.)
67 3. Runs the tests on the source tree and grades them. Writes
68 "tests.out" with a summary of the test results, and "details.out"
69 with test failure and warning details.
71 4. By hand, copy "review.txt" from the tests directory and use it as a
72 template for grading design documents.
74 5. Assembles "grade.txt", "tests.out", "review.txt", and "tests.out"
75 into "grade.out". This is primarily simple concatenation, but
76 point totals are tallied up as well.
79 -c, --clean Delete test results and temporary files, then exit.
80 -d, --do-tests=RE Run only tests that match the given regular expression.
81 -n, --no-tests=RE Do not run tests that match the given regular expression.
82 -x, --extract Stop after step 1.
83 -b, --build Stop after step 2.
84 -t, --test Stop after step 3 (default if "review.txt" not present).
85 -a, --assemble Stop after step 5 (default if "review.txt" exists).
86 -v, --verbose Print command lines of subcommands before executing them.
87 -h, --help Print this help message.
94 # Extracts the group's source files into pintos/src,
95 # applies any patches providing in the grading directory,
96 # and installs a default pintos/src/constants.h
98 # Make sure the output dir exists.
99 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
101 # Nothing else to do if we already have a source tree.
102 return if -d "pintos";
104 my ($tarball) = choose_tarball ();
107 print "Creating pintos/src...\n";
108 mkdir "pintos" or die "pintos: mkdir: $!\n";
109 mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
111 print "Extracting $tarball into pintos/src...\n";
112 xsystem ("cd pintos/src && tar xzf ../../$tarball",
113 DIE => "extraction failed\n");
115 # Run custom script for this submission, if provided.
117 print "Running fixme.sh...\n";
118 xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
120 print "No fixme.sh, assuming no custom changes needed.\n";
123 # Apply patches from grading directory.
124 # Patches are applied in lexicographic order, so they should
125 # probably be named 00debug.patch, 01bitmap.patch, etc.
126 # Filenames in patches should be in the format pintos/src/...
127 print "Patching...\n";
128 for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
130 ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
131 print "Applying $patch...\n";
132 xsystem ("patch -fs -p0 < $patch",
133 LOG => $stem, DIE => "applying patch $stem failed\n");
136 # Install default pintos/src/constants.h.
137 open (CONSTANTS, ">pintos/src/constants.h")
138 or die "constants.h: create: $!\n";
139 print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
143 # Returns the name of the tarball to extract.
146 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
148 die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
149 if scalar (@tarballs) == 0;
152 # Sort tarballs in order by time.
153 @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
155 print "Multiple tarballs:\n";
156 print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
157 print "Choosing $tarballs[$#tarballs]\n";
159 return $tarballs[$#tarballs];
162 # Extract the date within a tarball name into a string that compares
163 # lexicographically in chronological order.
166 my ($ms, $d, $y, $H, $M, $S) =
167 $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
169 my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
171 return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
177 print "Compiling...\n";
178 xsystem ("cd pintos/src/$hw && make", LOG => "make") eq 'ok'
179 or return "Build error";
182 # Run and grade the tests.
183 sub run_and_grade_tests {
186 my ($result) = get_test_result ();
189 my ($grade) = grade_test ($test);
192 my ($msg) = $result eq 'ok' ? $grade : "$result - $grade";
193 $msg .= " - with warnings"
194 if $grade eq 'ok' && defined $details{$test};
197 $result{$test} = $grade;
201 # Write test grades to tests.out.
203 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
209 for (my ($i) = 0; $i <= $#summary; $i++) {
210 local ($_) = $summary[$i];
211 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
212 my ($result) = $result{$test} || "Not tested.";
214 if ($result eq 'ok') {
215 if (!defined $details{$test}) {
216 # Test successful and no warnings.
217 splice (@summary, $i, 1);
220 # Test successful with warnings.
223 splice (@summary, $i + 1, 0,
224 " Test passed with warnings. "
225 . "Details at end of file.");
231 splice (@summary, $i + 1, 0,
232 map (" $_", split ("\n", $result)));
234 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
236 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
237 splice (@summary, $i, 0, " All tests passed.")
238 if $ploss == 0 && !$warnings;
244 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
245 $summary[0] =~ s/\[\[total\]\]/$ts/;
247 open (SUMMARY, ">tests.out");
248 print SUMMARY map ("$_\n", @summary);
252 # Write failure and warning details to details.out.
254 open (DETAILS, ">details.out");
257 next if $result{$test} eq 'ok' && !defined $details{$test};
259 my ($details) = $details{$test};
260 next if !defined ($details) && ! -e "output/$test/run.out";
263 if ($result{$test} ne 'ok') {
264 $banner = "$test failure details";
266 $banner = "$test warnings";
269 print DETAILS "\n" if $n++;
270 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
271 print DETAILS "\n\n";
273 if (!defined $details) {
274 my (@output) = snarf ("output/$test/run.out");
276 # Print only the first in a series of recursing panics.
278 for my $i (0...$#output) {
279 local ($_) = $output[$i];
280 if (/PANIC/ && $panic++ > 0) {
281 @output = @output[0...$i];
283 "[...details of recursive panic(s) omitted...]");
287 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
289 print DETAILS $details;
291 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
292 if defined $extra{$test};
298 my ($command, %options) = @_;
299 print "$command\n" if $verbose || $options{VERBOSE};
301 my ($log) = $options{LOG};
305 local $SIG{ALRM} = sub { die "alarm\n" };
306 alarm $options{TIMEOUT} if defined $options{TIMEOUT};
308 die "fork: $!\n" if !defined $pid;
311 open (STDOUT, ">output/$log.out");
312 open (STDERR, ">output/$log.err");
324 die unless $@ eq "alarm\n"; # propagate unexpected errors
326 for ($i = 0; $i < 10; $i++) {
327 kill ('SIGTERM', $pid);
329 my ($retval) = waitpid ($pid, WNOHANG);
330 last if $retval == $pid || $retval == -1;
331 print "Timed out - Waiting for $pid to die" if $i == 0;
337 if (WIFSIGNALED ($status)) {
338 my ($signal) = WTERMSIG ($status);
339 die "Interrupted\n" if $signal == SIGINT;
340 print "Child terminated with signal $signal\n";
343 my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
344 $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
349 if ($result eq 'error' && defined $options{DIE}) {
350 my ($msg) = $options{DIE};
351 if (defined ($log)) {
353 $msg .= "; see output/$log.err and output/$log.out for details\n";
356 } elsif ($result ne 'error' && defined ($log)) {
357 unlink ("output/$log.err");
363 sub get_test_result {
364 my ($cache_file) = "output/$test/run.result";
365 # Reuse older results if any.
366 if (open (RESULT, "<$cache_file")) {
374 # If there's residue from an earlier test, move it to .old.
375 # If there's already a .old, delete it.
376 xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
377 rename "output/$test", "output/$test.old" or die "rename: $!\n"
378 if -d "output/$test";
380 # Make output directory.
381 mkdir "output/$test";
384 my ($result) = run_test ($test);
386 # Delete any disks in the output directory because they take up
388 unlink (glob ("output/$test/*.dsk"));
390 # Save the results for later.
391 open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
392 print DONE "$result\n";
399 my ($cmd_line, %args) = @_;
400 $args{EXPECT} = 1 unless defined $args{EXPECT};
401 my ($retval) = xsystem ($cmd_line, %args);
402 return 'ok' if $retval eq 'ok';
403 return "Timed out after $args{TIMEOUT} seconds" if $retval eq 'timeout';
404 return 'Error running Bochs' if $retval eq 'error';
411 my ($outfile) = "output/$test/run.out";
412 die "$outfile: missing test output file (make failed?)" if ! -e $outfile;
413 my (@output) = snarf ($outfile);
415 # If there's a function "grade_$test", use it to evaluate the output.
416 # If there's a file "$GRADES_DIR/$test.exp", compare its contents
417 # against the output.
418 # (If both exist, prefer the function.)
420 # If the test was successful, it returns normally.
421 # If it failed, it invokes `die' with an error message terminated
422 # by a new-line. The message will be given as an explanation in
423 # the output file tests.out.
424 # (Internal errors will invoke `die' without a terminating
425 # new-line, in which case we detect it and propagate the `die'
427 my ($grade_func) = "grade_$test";
428 $grade_func =~ s/-/_/g;
429 if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
431 verify_common (@output);
432 compare_output ("$GRADES_DIR/$test.exp", @output);
435 eval "$grade_func (\@output)";
438 die $@ if $@ =~ /at \S+ line \d+$/;
445 # Combines grade.txt, tests.out, review.txt, and details.out,
446 # producing grade.out.
447 sub assemble_final_grade {
448 open (OUT, ">grade.out") or die "grade.out: create: $!\n";
450 open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
457 my (@tests) = snarf ("tests.out");
458 my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
460 my (@review) = snarf ("review.txt");
461 my ($part_lost) = (0, 0);
462 for (my ($i) = $#review; $i >= 0; $i--) {
463 local ($_) = $review[$i];
464 if (my ($loss) = /^\s*([-+]\d+)/) {
466 } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
467 my ($got) = $out_of + $part_lost;
468 $got = 0 if $got < 0;
469 $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
476 die "Lost points outside a section\n" if $part_lost;
478 for (my ($i) = 1; $i <= $#review; $i++) {
479 if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
480 $review[$i] = '-' x (length ($review[$i - 1]));
484 print OUT "\nOVERALL SCORE\n";
485 print OUT "-------------\n";
486 print OUT "$p_got points out of $p_pos total\n\n";
488 print OUT map ("$_\n", @tests), "\n";
489 print OUT map ("$_\n", @review), "\n";
491 print OUT "DETAILS\n";
492 print OUT "-------\n\n";
493 print OUT map ("$_\n", snarf ("details.out"));
496 # Clean up our generated files.
498 # Verify that we're roughly in the correct directory
499 # before we go blasting away files.
502 # Blow away everything.
503 xsystem ("rm -rf output pintos", VERBOSE => 1);
504 xsystem ("rm -f details.out tests.out", VERBOSE => 1);
507 # Provided a test's output as an array, verifies that it, in general,
508 # looks sensible; that is, that there are no PANIC or FAIL messages,
509 # that Pintos started up and shut down normally, and so on.
510 # Die if something odd found.
514 die "No output at all\n" if @output == 0;
516 look_for_panic (@output);
517 look_for_fail (@output);
518 look_for_triple_fault (@output);
520 die "Didn't start up properly: no \"Pintos booting\" startup message\n"
521 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
522 die "Didn't start up properly: no \"Boot complete\" startup message\n"
523 if !grep (/Boot complete/, @output);
524 die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
525 if !grep (/Timer: \d+ ticks/, @output);
526 die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
527 if !grep (/Powering off/, @output);
533 my ($panic) = grep (/PANIC/, @output);
534 return unless defined $panic;
536 my ($details) = "Kernel panic:\n $panic\n";
538 my (@stack_line) = grep (/Call stack:/, @output);
539 if (@stack_line != 0) {
540 $details .= " $stack_line[0]\n\n";
541 $details .= "Translation of backtrace:\n";
542 my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
546 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
549 $A2L = "i386-elf-addr2line";
552 if ($hw eq 'threads') {
553 $kernel_o = "output/$test/kernel.o";
555 $kernel_o = "pintos/src/$hw/build/kernel.o";
557 open (A2L, "$A2L -fe $kernel_o @addrs|");
559 my ($function, $line);
560 last unless defined ($function = <A2L>);
564 $details .= " $function ($line)\n";
568 if ($panic =~ /sec_no < d->capacity/) {
570 \nThis assertion commonly fails when accessing a file via an inode that
571 has been closed and freed. Freeing an inode clears all its sector
572 indexes to 0xcccccccc, which is not a valid sector number for disks
573 smaller than about 1.6 TB.
577 $extra{$test} = $details;
578 die "Kernel panic. Details at end of file.\n";
584 my ($failure) = grep (/FAIL/, @output);
585 return unless defined $failure;
587 # Eliminate uninteresting header and trailer info if possible.
588 # The `eval' catches the `die' from get_core_output() in the "not
591 my (@core) = get_core_output (@output);
592 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
595 # Most output lines are prefixed by (test-name). Eliminate this
596 # from our `die' message for brevity.
597 $failure =~ s/^\([^\)]+\)\s+//;
598 die "$failure. Details at end of file.\n";
601 sub look_for_triple_fault {
604 return unless grep (/Pintos booting/, @output) > 1;
606 my ($details) = <<EOF;
607 Pintos spontaneously rebooted during this test. This is most often
608 due to unhandled page faults. Output from initial boot through the
609 first reboot is shown below:
617 last if /Pintos booting/ && ++$i > 1;
619 $details{$test} = $details;
620 die "Triple-fault caused spontaneous reboot(s). "
621 . "Details at end of file.\n";
624 # Get @output without header or trailer.
625 # Die if not possible.
626 sub get_core_output {
630 for ($first = 0; $first <= $#output; $first++) {
631 my ($line) = $output[$first];
633 if ($hw ne 'threads' && $line =~ /^Executing '$test.*':$/)
635 && grep (/^Boot complete.$/, @output[0...$first - 1])
636 && $line =~ /^\s*$/);
640 for ($last = $#output; $last >= 0; $last--) {
641 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
644 if ($last < $first) {
645 my ($no_first) = $first > $#output;
646 my ($no_last) = $last < $#output;
647 die "Couldn't locate output.\n";
650 return @output[$first ... $last];
653 sub canonicalize_exit_codes {
656 # Exit codes are supposed to be printed in the form "process: exit(code)"
657 # but people get unfortunately creative with it.
658 for my $i (0...$#output) {
659 local ($_) = $output[$i];
661 my ($process, $code);
662 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
663 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
664 || (($process, $code)
665 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
666 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
667 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/))
669 # We additionally truncate to 15 character and strip all
670 # but the first word.
671 $process = substr ($process, 0, 15);
672 $process =~ s/\s.*//;
673 $output[$i] = "$process: exit($code)\n";
680 sub strip_exit_codes {
681 return grep (!/^[-a-z0-9]+: exit\(-?\d+\)/, canonicalize_exit_codes (@_));
685 my ($exp, @actual) = @_;
687 # Canonicalize output for comparison.
688 @actual = get_core_output (map ("$_\n", @actual));
689 if ($hw eq 'userprog') {
690 @actual = canonicalize_exit_codes (@actual);
691 } elsif ($hw eq 'vm' || $hw eq 'filesys') {
692 @actual = strip_exit_codes (@actual);
695 # There *was* some output, right?
696 die "Program produced no output.\n" if !@actual;
698 # Read expected output.
699 my (@exp) = map ("$_\n", snarf ($exp));
701 # Pessimistically, start preparation of detailed failure message.
703 $details .= "$test actual output:\n";
704 $details .= join ('', map (" $_", @actual));
706 # Set true when we find expected output that matches our actual
707 # output except for some extra actual output (that doesn't seem to
708 # be an error message etc.).
709 my ($fuzzy_match) = 0;
711 # Compare actual output against each allowed output.
713 # Grab one set of allowed output from @exp into @expected.
716 my ($s) = shift (@exp);
717 last if $s eq "--OR--\n";
718 push (@expected, $s);
721 $details .= "\n$test acceptable output:\n";
722 $details .= join ('', map (" $_", @expected));
724 # Check whether actual and expected match.
725 # If it's a perfect match, return.
726 if ($#actual == $#expected) {
728 for (my ($i) = 0; $i <= $#expected; $i++) {
729 $eq = 0 if $actual[$i] ne $expected[$i];
734 # They differ. Output a diff.
736 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
737 my ($not_fuzzy_match) = 0;
738 while ($d->Next ()) {
739 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
741 push (@diff, map (" $_", $d->Items (1)));
743 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
744 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
746 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
748 $not_fuzzy_match = 1;
753 # If we didn't find anything that means it's not,
754 # it's a fuzzy match.
755 $fuzzy_match = 1 if !$not_fuzzy_match;
757 $details .= "Differences in `diff -u' format:\n";
758 $details .= join ('', @diff);
759 $details .= "(This is considered a `fuzzy match'.)\n"
760 if !$not_fuzzy_match;
763 # Failed to match. Report failure.
766 "This test passed, but with extra, unexpected output.\n"
767 . "Please inspect your code to make sure that it does not\n"
768 . "produce output other than as specified in the project\n"
773 "This test failed because its output did not match any\n"
774 . "of the acceptable form(s).\n\n"
778 $details{$test} = $details;
779 die "Output differs from expected. Details at end of file.\n"
783 # Reads and returns the contents of the specified file.
784 # In an array context, returns the file's contents as an array of
785 # lines, omitting new-lines.
786 # In a scalar context, returns the file's contents as a single string.
789 open (OUTPUT, $file) or die "$file: open: $!\n";
790 my (@lines) = <OUTPUT>;
793 return wantarray ? @lines : join ('', map ("$_\n", @lines));
796 # Returns true if the two specified files are byte-for-byte identical,
801 open (A, "<$a") or die "$a: open: $!\n";
802 open (B, "<$b") or die "$b: open: $!\n";
808 sysread (A, $sa, 1024);
809 sysread (B, $sb, 1024);
810 $equal = 0, last if $sa ne $sb;
811 $equal = 1, last if $sa eq '';
819 # Returns true if the specified file is byte-for-byte identical with
820 # the specified string.
822 my ($file, $expected) = @_;
823 open (FILE, "<$file") or die "$file: open: $!\n";
825 sysread (FILE, $actual, -s FILE);
826 my ($equal) = $actual eq $expected;