3 # Find the directory that contains the grading files.
4 use vars qw($GRADES_DIR);
6 # Add our Perl library directory to the include path.
8 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
9 -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
10 unshift @INC, "$GRADES_DIR/../lib";
21 our ($verbose) = 0; # Verbosity of output
22 our (@TESTS); # Tests to run.
26 GetOptions ("v|verbose+" => \$verbose,
27 "h|help" => sub { usage (0) },
28 "t|test=s" => \@TESTS,
31 or die "Malformed command line; use --help for help.\n";
32 die "Non-option argument not supported; use --help for help.\n"
37 print "run-tests, for grading Pintos multiprogramming projects.\n\n";
38 print "Invoke from a directory containing a student tarball named by\n";
39 print "the submit script, e.g. username.Oct.12.04.20.04.09.tar.gz.\n";
40 print "In normal usage, no options are needed.\n\n";
41 print "Output is produced in tests.out and details.out.\n\n";
43 print " -c, --clean Remove old output files before starting\n";
44 print " -t, --test=TEST Execute TEST only (allowed multiple times)\n";
45 print " -g, --grade Instead of running tests, compose grade.out\n";
46 print " -v, --verbose Print commands before executing them\n";
47 print " -h, --help Print this help message\n";
51 # Default set of tests.
52 @TESTS = qw (sm-create sm-full sm-seq-block sm-seq-random sm-random
54 grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell
55 grow-sparse grow-too-big grow-root-sm grow-root-lg grow-dir-lg
58 dir-mkdir dir-rmdir dir-mk-vine dir-rm-vine dir-mk-tree
59 dir-rm-tree dir-lsdir dir-rm-cwd dir-rm-cwd-cd
60 dir-rm-parent dir-rm-root dir-over-file dir-under-file
61 dir-empty-name dir-open
63 syn-remove syn-read syn-write syn-rw
68 # Handle final grade mode.
70 open (OUT, ">grade.out") or die "grade.out: create: $!\n";
72 open (GRADE, "<grade.txt") or die "grade.txt: open: $!\n";
79 my (@tests) = snarf ("tests.out");
80 my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die;
82 my (@review) = snarf ("review.txt");
83 my ($part_lost) = (0, 0);
84 for (my ($i) = $#review; $i >= 0; $i--) {
85 local ($_) = $review[$i];
86 if (my ($loss) = /^\s*([-+]\d+)/) {
88 } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) {
89 my ($got) = $out_of + $part_lost;
91 $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die;
98 die "Lost points outside a section\n" if $part_lost;
100 for (my ($i) = 1; $i <= $#review; $i++) {
101 if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) {
102 $review[$i] = '-' x (length ($review[$i - 1]));
106 print OUT "\nOVERALL SCORE\n";
107 print OUT "-------------\n";
108 print OUT "$p_got points out of $p_pos total\n\n";
110 print OUT map ("$_\n", @tests), "\n";
111 print OUT map ("$_\n", @review), "\n";
113 print OUT "DETAILS\n";
114 print OUT "-------\n\n";
115 print OUT map ("$_\n", snarf ("details.out"));
121 # Verify that we're roughly in the correct directory
122 # before we go blasting away files.
125 xsystem ("rm -rf output pintos", VERBOSE => 1);
126 xsystem ("rm -f details.out tests.out", VERBOSE => 1);
129 # Create output directory, if it doesn't already exist.
130 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
132 # Extract submission.
135 # Compile submission.
138 # Verify that the proper directory was submitted.
139 -d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
141 # Run and grade the tests.
147 my ($result) = get_test_result ();
148 if ($result eq 'ok') {
149 $result = grade_test ($test);
150 } elsif ($result =~ /^Timed out/) {
151 $result = "$result - " . grade_test ($test);
155 print " - with warnings" if $result eq 'ok' && defined $details{$test};
158 $result{$test} = $result;
166 sub grade_process_death {
167 my ($proc_name, @output) = @_;
169 verify_common (@output);
170 @output = get_core_output (@output);
171 die "First line of output is not `($proc_name) begin' message.\n"
172 if $output[0] ne "($proc_name) begin";
173 die "Output contains `FAIL' message.\n"
174 if grep (/FAIL/, @output);
175 die "Output contains spurious ($proc_name) message.\n"
176 if grep (/\($proc_name\)/, @output) > 1;
179 sub grade_pt_bad_addr {
180 grade_process_death ('pt-bad-addr', @_);
183 sub grade_pt_write_code {
184 grade_process_death ('pt-write-code', @_);
187 sub grade_mmap_unmap {
188 grade_process_death ('mmap-unmap', @_);
194 my (@assertion) = grep (/PANIC/, @output);
195 if (@assertion != 0) {
196 my ($details) = "Kernel panic:\n $assertion[0]\n";
198 my (@stack_line) = grep (/Call stack:/, @output);
199 if (@stack_line != 0) {
200 $details .= " $stack_line[0]\n\n";
201 $details .= "Translation of backtrace:\n";
202 my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
206 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
209 $A2L = "i386-elf-addr2line";
211 open (A2L, "$A2L -fe pintos/src/filesys/build/kernel.o @addrs|");
213 my ($function, $line);
214 last unless defined ($function = <A2L>);
218 $details .= " $function ($line)\n";
222 if ($assertion[0] =~ /sec_no < d->capacity/) {
224 \nThis assertion commonly fails when accessing a file via
225 an inode that has been closed and freed. Freeing an inode
226 clears all its sector indexes to 0xcccccccc, which is not
227 a valid sector number for disks smaller than about 1.6 TB.
231 $extra{$test} = $details;
232 die "Kernel panic. Details at end of file.\n"
235 my (@failure) = grep (/FAIL/, @output);
238 my (@core) = get_core_output (@output);
239 $details{$test} = "Program output:\n\n" . join ('', map ("$_\n", @core));
241 my ($failure) = $failure[0];
242 $failure =~ s/^\([^)]+\)\s+//;
243 die "Failed with message \"$failure\"\n";
246 if (grep (/Pintos booting/, @output) > 1) {
249 $details = "Pintos spontaneously rebooted during this test.\n";
250 $details .= "This is most often due to unhandled page faults.\n";
251 $details .= "Here's the output from the initial boot through the\n";
252 $details .= "first reboot:\n\n";
258 last if /Pintos booting/ && ++$i > 1;
260 $details{$test} = $details;
261 die "Triple-fault caused spontaneous reboot(s). "
262 . "Details at end of file.\n";
265 die "No output at all\n" if @output == 0;
266 die "Didn't start up properly: no \"Pintos booting\" startup message\n"
267 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
268 die "Didn't start up properly: no \"Boot complete\" startup message\n"
269 if !grep (/Boot complete/, @output);
270 die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
271 if !grep (/Timer: \d+ ticks/, @output);
272 die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
273 if !grep (/Powering off/, @output);
276 # Get @output without header or trailer.
277 sub get_core_output {
281 for ($first = 0; $first <= $#output; $first++) {
282 $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
286 for ($last = $#output; $last >= 0; $last--) {
287 $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
290 if ($last < $first) {
291 my ($no_first) = $first > $#output;
292 my ($no_last) = $last < $#output;
293 die "Couldn't locate output.\n";
296 return @output[$first ... $last];
302 # Remove lines that look like exit codes.
303 # Exit codes are supposed to be printed in the form "process: exit(code)"
304 # but people get unfortunately creative with it.
305 for (my ($i) = 0; $i <= $#output; $i++) {
306 local ($_) = $output[$i];
308 my ($process, $code);
309 if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
310 || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/)
311 || (($process, $code)
312 = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
313 || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/)
314 || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/)
316 splice (@output, $i, 1);
325 my ($exp, @actual) = @_;
326 @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual)));
327 die "Program produced no output.\n" if !@actual;
330 $details .= "$test actual output:\n";
331 $details .= join ('', map (" $_", @actual));
333 my (@exp) = map ("$_\n", snarf ($exp));
335 my ($fuzzy_match) = 0;
339 my ($s) = shift (@exp);
340 last if $s eq "--OR--\n";
341 push (@expected, $s);
344 $details .= "\n$test acceptable output:\n";
345 $details .= join ('', map (" $_", @expected));
347 # Check whether they're the same.
348 if ($#actual == $#expected) {
350 for (my ($i) = 0; $i <= $#expected; $i++) {
351 $eq = 0 if $actual[$i] ne $expected[$i];
356 # They differ. Output a diff.
358 my ($d) = Algorithm::Diff->new (\@expected, \@actual);
359 my ($not_fuzzy_match) = 0;
360 while ($d->Next ()) {
361 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
363 push (@diff, map (" $_", $d->Items (1)));
365 push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
366 push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
368 || grep (/\($test\)|exit\(-?\d+\)|dying due to|Page fault/,
370 $not_fuzzy_match = 1;
374 $fuzzy_match = 1 if !$not_fuzzy_match;
376 $details .= "Differences in `diff -u' format:\n";
377 $details .= join ('', @diff);
378 $details .= "(This is considered a `fuzzy match'.)\n"
379 if !$not_fuzzy_match;
384 "This test passed, but with extra, unexpected output.\n"
385 . "Please inspect your code to make sure that it does not\n"
386 . "produce output other than as specified in the project\n"
391 "This test failed because its output did not match any\n"
392 . "of the acceptable form(s).\n\n"
396 $details{$test} = $details;
397 die "Output differs from expected. Details at end of file.\n"
402 my (@summary) = snarf ("$GRADES_DIR/tests.txt");
408 for (my ($i) = 0; $i <= $#summary; $i++) {
409 local ($_) = $summary[$i];
410 if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) {
411 my ($result) = $result{$test} || "Not tested.";
413 if ($result eq 'ok') {
414 if (!defined $details{$test}) {
415 # Test successful and no warnings.
416 splice (@summary, $i, 1);
419 # Test successful with warnings.
422 splice (@summary, $i + 1, 0,
423 " Test passed with warnings. "
424 . "Details at end of file.");
430 splice (@summary, $i + 1, 0,
431 map (" $_", split ("\n", $result)));
433 } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
435 $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
436 splice (@summary, $i, 0, " All tests passed.")
437 if $ploss == 0 && !$warnings;
443 my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
444 $summary[0] =~ s/\[\[total\]\]/$ts/;
446 open (SUMMARY, ">tests.out");
447 print SUMMARY map ("$_\n", @summary);
452 open (DETAILS, ">details.out");
455 next if $result{$test} eq 'ok' && !defined $details{$test};
457 my ($details) = $details{$test};
458 next if !defined ($details) && ! -e "output/$test/run.out";
461 if ($result{$test} ne 'ok') {
462 $banner = "$test failure details";
464 $banner = "$test warnings";
467 print DETAILS "\n" if $n++;
468 print DETAILS "--- $banner ", '-' x (50 - length ($banner));
469 print DETAILS "\n\n";
471 if (!defined $details) {
472 my (@output) = snarf ("output/$test/run.out");
474 # Print only the first in a series of recursing panics.
476 for my $i (0...$#output) {
477 local ($_) = $output[$i];
478 if (/PANIC/ && $panic++ > 0) {
479 @output = @output[0...$i];
481 "[...details of recursive panic(s) omitted...]");
485 $details = "Output:\n\n" . join ('', map ("$_\n", @output));
487 print DETAILS $details;
489 print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
490 if defined $extra{$test};
498 open (OUTPUT, $file) or die "$file: open: $!\n";
499 my (@lines) = <OUTPUT>;
502 return wantarray ? @lines : join ('', map ("$_\n", @lines));
508 open (A, "<$a") or die "$a: open: $!\n";
509 open (B, "<$b") or die "$b: open: $!\n";
515 sysread (A, $sa, 1024);
516 sysread (B, $sb, 1024);
517 $equal = 0, last if $sa ne $sb;
518 $equal = 1, last if $sa eq '';
527 my ($file, $expected) = @_;
528 open (FILE, "<$file") or die "$file: open: $!\n";
530 sysread (FILE, $actual, -s FILE);
531 my ($equal) = $actual eq $expected;
537 my ($ln, $lines) = @_;
539 for my $line (@$lines) {
541 $out .= sprintf "%4d %s\n", $ln++, $line;