X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=grading%2Fuserprog%2Frun-tests;h=9384ebad57cdb4a33ef9d393ae7fda424d4575cc;hb=be193f8d945ee145b404e8b33fae7616a4b408f4;hp=e2587c20a44e2f6ddf2fb8dce94d5910b1e2ccab;hpb=bd7bad8e3881965f74070ce7b685fedbdaf8fb1c;p=pintos-anon diff --git a/grading/userprog/run-tests b/grading/userprog/run-tests index e2587c2..9384eba 100755 --- a/grading/userprog/run-tests +++ b/grading/userprog/run-tests @@ -1,307 +1,88 @@ #! /usr/bin/perl -use warnings; -use strict; -use POSIX; -use Algorithm::Diff; -use Getopt::Long; - -our ($VERBOSE) = 0; # Verbosity of output -our (@TESTS); # Tests to run. -my ($clean) = 0; -my ($grade) = 0; - -GetOptions ("v|verbose+" => \$VERBOSE, - "h|help" => sub { usage (0) }, - "t|test=s" => \@TESTS, - "c|clean" => \$clean, - "g|grade" => \$grade) - or die "Malformed command line; use --help for help.\n"; -die "Non-option argument not supported; use --help for help.\n" - if @ARGV > 0; - -sub usage { - my ($exitcode) = @_; - print "run-tests, for grading Pintos multiprogramming projects.\n\n"; - print "Invoke from a directory containing a student tarball named by\n"; - print "the submit script, e.g. username.Oct.12.04.20.04.09.tar.gz.\n"; - print "In normal usage, no options are needed.\n\n"; - print "Output is produced in tests.out and details.out.\n\n"; - print "Options:\n"; - print " -c, --clean Remove old output files before starting\n"; - print " -t, --test=TEST Execute TEST only (allowed multiple times)\n"; - print " -g, --grade Instead of running tests, compose grade.out\n"; - print " -v, --verbose Print commands before executing them\n"; - print " -h, --help Print this help message\n"; - exit $exitcode; -} - -# Default set of tests. -@TESTS = qw (args-argc args-argv0 args-argvn args-single args-multiple - args-dbl-space - sc-bad-sp sc-bad-arg sc-boundary - halt exit - create-normal create-empty create-null create-bad-ptr - create-long create-exists create-bound - open-normal open-missing open-boundary open-empty open-null - open-bad-ptr open-twice - close-normal close-twice close-stdin close-stdout close-bad-fd - read-normal read-bad-ptr read-boundary read-zero read-stdout - read-bad-fd - write-normal write-bad-ptr write-boundary write-zero write-stdin - write-bad-fd - exec-once exec-arg exec-multiple exec-missing exec-bad-ptr - multi-recurse multi-oom multi-child-fd - ) unless @TESTS > 0; - -our (%args); -for my $key ('args-argc', 'args-argv0', 'args-argvn', 'args-multiple') { - $args{$key} = "some arguments for you!"; -} -$args{'args-single'} = "onearg"; -$args{'args-dbl-space'} = "two args"; -$args{'multi-recurse'} = "15"; -$args{'multi-oom'} = "0"; - -# Handle final grade mode. -if ($grade) { - open (OUT, ">grade.out") or die "grade.out: create: $!\n"; - - open (GRADE, ") { - last if /^\s*$/; - print OUT; - } - close (GRADE); - - my (@tests) = snarf ("tests.out"); - my ($p_got, $p_pos) = $tests[0] =~ m%\((\d+)/(\d+)\)% or die; - - my (@review) = snarf ("review.txt"); - my ($part_lost) = (0, 0); - for (my ($i) = $#review; $i >= 0; $i--) { - local ($_) = $review[$i]; - if (my ($loss) = /^\s*([-+]\d+)/) { - $part_lost += $loss; - } elsif (my ($out_of) = m%\[\[/(\d+)\]\]%) { - my ($got) = $out_of + $part_lost; - $got = 0 if $got < 0; - $review[$i] =~ s%\[\[/\d+\]\]%($got/$out_of)% or die; - $part_lost = 0; - - $p_got += $got; - $p_pos += $out_of; - } - } - die "Lost points outside a section\n" if $part_lost; - - for (my ($i) = 1; $i <= $#review; $i++) { - if ($review[$i] =~ /^-{3,}\s*$/ && $review[$i - 1] !~ /^\s*$/) { - $review[$i] = '-' x (length ($review[$i - 1])); - } - } - - print OUT "\nOVERALL SCORE\n"; - print OUT "-------------\n"; - print OUT "$p_got points out of $p_pos total\n\n"; - - print OUT map ("$_\n", @tests), "\n"; - print OUT map ("$_\n", @review), "\n"; - - print OUT "DETAILS\n"; - print OUT "-------\n\n"; - print OUT map ("$_\n", snarf ("details.out")); - - exit 0; -} - # Find the directory that contains the grading files. our ($GRADES_DIR); -($GRADES_DIR = $0) =~ s#/[^/]+$##; --d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n"; - -if ($clean) { - # Verify that we're roughly in the correct directory - # before we go blasting away files. - choose_tarball (); - xsystem ("rm -rf output pintos", VERBOSE => 1); - xsystem ("rm -f details.out tests.out", VERBOSE => 1); +# Add our Perl library directory to the include path. +BEGIN { + ($GRADES_DIR = $0) =~ s#/[^/]+$##; + -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n"; + unshift @INC, "$GRADES_DIR/../lib"; } -# Create output directory, if it doesn't already exist. --d ("output") || mkdir ("output") or die "output: mkdir: $!\n"; - -# Extract submission. -extract_tarball () if ! -d "pintos"; - -# Compile submission. -compile (); - -# Verify that the proper directory was submitted. --d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n"; - -# Run and grade the tests. -our $test; -our %result; -our %details; -our %extra; -for $test (@TESTS) { - print "$test: "; - my ($result) = run_test ($test); - if ($result eq 'ok') { - $result = grade_test ($test); - $result =~ s/\n$//; - } - print "$result"; - print " - with warnings" if $result eq 'ok' && defined $details{$test}; - print "\n"; - - $result{$test} = $result; -} +use warnings; +use strict; +use Pintos::Grading; -# Write output. -write_grades (); +our ($hw) = "userprog"; +our (@TESTS); # Tests to run. +our ($test); +our (%extra); +our ($action); + +parse_cmd_line qw (args-argc args-argv0 args-argvn args-single args-multiple + args-dbl-space + sc-bad-sp sc-bad-arg sc-boundary + halt exit + create-normal create-empty create-null create-bad-ptr + create-long create-exists create-bound + open-normal open-missing open-boundary open-empty open-null + open-bad-ptr open-twice + close-normal close-twice close-stdin close-stdout + close-bad-fd + read-normal read-bad-ptr read-boundary read-zero read-stdout + read-bad-fd + write-normal write-bad-ptr write-boundary write-zero + write-stdin write-bad-fd + exec-once exec-arg exec-multiple exec-missing exec-bad-ptr + join-simple join-twice join-killed join-bad-pid + multi-recurse multi-oom multi-child-fd); + +clean_dir (), exit if $action eq 'clean'; + +extract_sources (); +exit if $action eq 'extract'; + +build (); +exit if $action eq 'build'; + +run_and_grade_tests (); +write_grades (); write_details (); - -sub choose_tarball { - my (@tarballs) - = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/, - glob ("*.tar.gz")); - die "no pintos dir and no source tarball\n" if scalar (@tarballs) == 0; - - # Sort tarballs in reverse order by time. - @tarballs = sort { ext_mdyHMS ($b) cmp ext_mdyHMS ($a) } @tarballs; - - print "Multiple tarballs: choosing $tarballs[0]\n" - if scalar (@tarballs) > 1; - return $tarballs[0]; -} - -sub extract_tarball { - my ($tarball) = choose_tarball (); - - mkdir "pintos" or die "pintos: mkdir: $!\n"; - mkdir "pintos/src" or die "pintos: mkdir: $!\n"; - - print "Extracting $tarball...\n"; - xsystem ("cd pintos/src && tar xzf ../../$tarball", - DIE => "extraction failed\n"); - - print "Patching...\n"; - xsystem ("patch -fs pintos/src/lib/debug.c < $GRADES_DIR/panic.diff", - LOG => "patch", - DIE => "patch failed\n"); - xsystem ("patch -fs pintos/src/lib/kernel/bitmap.c " - . "< $GRADES_DIR/random.diff", - LOG => "patch", - DIE => "patch failed\n"); +exit if $action eq 'test'; - open (CONSTANTS, ">pintos/src/constants.h") - or die "constants.h: create: $!\n"; - print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n"; - close CONSTANTS; -} - -sub ext_mdyHMS { - my ($s) = @_; - my ($ms, $d, $y, $H, $M, $S) = - $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/ - or die; - my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3 - or die; - return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S; -} - -sub test_source { - my ($test) = @_; - my ($src) = "$GRADES_DIR/$test.c"; - -e $src or die "$src: stat: $!\n"; - return $src; -} +assemble_final_grade (); +exit if $action eq 'assemble'; -sub test_constants { - my ($defines) = ""; - return $defines; - } +die "Don't know how to '$action'"; +# Runs $test in directory output/$test. +# Returns 'ok' if it went ok, otherwise an explanation. sub run_test { - my ($test) = @_; - - # Reuse older results if any. - if (open (DONE, "; - chomp $status; - close (DONE); - return $status; - } - - # Really run the test. - my ($status) = really_run_test ($test); - - # Save the results for later. - open (DONE, ">output/$test/done") or die "output/$test/done: create: $!\n"; - print DONE "$status\n"; - close (DONE); - - return $status; -} - -sub compile { - print "Compiling...\n"; - xsystem ("cd pintos/src/userprog && make", LOG => "make") - or return "compile error"; -} - -sub really_run_test { - # Need to run it. - # If there's residue from an earlier test, move it to .old. - # If there's already a .old, delete it. - xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old"; - rename "output/$test", "output/$test.old" or die "rename: $!\n" - if -d "output/$test"; - - # Make output directory. - mkdir "output/$test"; xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk", DIE => "cp failed\n"); - # Run. - my ($timeout) = 10; - $timeout = 60 if $test eq 'multi-oom'; - my ($testargs) = defined ($args{$test}) ? " $args{$test}" : ""; - xsystem ("pintos " - . "--os-disk=pintos/src/userprog/build/os.dsk " - . "--fs-disk=output/$test/fs.dsk " - . "-v run -q -ex \"$test$testargs\"", - LOG => "$test/run", - TIMEOUT => $timeout) - or return "Bochs error"; - - return "ok"; -} - -sub grade_test { - my ($test) = @_; + my ($args) = ""; + $args = 'some arguments for you!' + if grep ($_ eq $test, qw(args-argc args-argv0 + args-argvn args-multiple)); + $args = 'onearg' if $test eq 'args-single'; + $args = 'two args' if $test eq 'args-dbl-space'; + $args = '15' if $test eq 'multi-recurse'; + $args = '0' if $test eq 'multi-oom'; + $args = " $args" if $args ne ''; - my (@output) = snarf ("output/$test/run.out"); - - my ($grade_func) = "grade_$test"; - $grade_func =~ s/-/_/g; - if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) { - eval { - verify_common (@output); - compare_output ("$GRADES_DIR/$test.exp", @output); - } - } else { - eval "$grade_func (\@output)"; - } - if ($@) { - die $@ if $@ =~ /at \S+ line \d+$/; - return $@; - } - return "ok"; + # Run. + my ($timeout) = $test !~ /^multi-/ ? 10 : 600; + my ($result) = run_pintos ("pintos " + . "--os-disk=pintos/src/userprog/build/os.dsk " + . "--fs-disk=output/$test/fs.dsk " + . "-v run -q -ex \"$test$args\"", + LOG => "$test/run", + TIMEOUT => $timeout); + rename "output/$test/fs.dsk", "output/$test/fs.dsk.keep" + if $test eq 'write-normal'; + return $result; } sub grade_write_normal { @@ -339,332 +120,49 @@ sub grade_multi_oom { my (@output) = @_; verify_common (@output); - @output = fix_exit_codes (get_core_output (@output)); + @output = canonicalize_exit_codes (get_core_output (@output)); my ($n) = 0; while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) { die "Child process $m started out of order.\n" if $m != $n; $n = $m + 1; shift @output; } - die "Only $n child processes started.\n" if $n < 15; + die "Only $n child process(es) started.\n" if $n < 15; + + # There could be a death notice for a process that didn't get + # fully loaded, and/or notices from the loader. + while (@output > 0 + && ($output[0] =~ /^multi-oom: exit\(-1\)$/ + || $output[0] =~ /^load: /)) { + shift @output; + } + while (--$n >= 0) { die "Output ended unexpectedly before process $n finished.\n" if @output < 2; + + local ($_); + chomp ($_ = shift @output); + die "Found '$_' expecting 'end' message.\n" if !/^\(multi-oom\) end/; die "Child process $n ended out of order.\n" - if $output[0] !~ /^\(multi-oom\) end $n$/; - shift @output; + if !/^\(multi-oom\) end $n$/; - die "Child process $n didn't print proper exit message.\n" - if $output[0] !~ /^multi-oom: exit\($n\)$/; - shift @output; + chomp ($_ = shift @output); + die "Kernel didn't print proper exit message for process $n.\n" + if !/^multi-oom: exit\($n\)$/; } die "Spurious output at end: '$output[0]'.\n" if @output; } sub get_file { my ($guest_fn, $host_fn) = @_; - xsystem ("pintos " - . "--os-disk=pintos/src/userprog/build/os.dsk " - . "--fs-disk=output/$test/fs.dsk " - . "-v get $guest_fn $host_fn", - LOG => "$test/get-$guest_fn", - TIMEOUT => 10) - or die "get $guest_fn failed\n"; -} - - -sub verify_common { - my (@output) = @_; - - my (@assertion) = grep (/PANIC/, @output); - if (@assertion != 0) { - my ($details) = "Kernel panic:\n $assertion[0]\n"; - - my (@stack_line) = grep (/Call stack:/, @output); - if (@stack_line != 0) { - $details .= " $stack_line[0]\n\n"; - $details .= "Translation of backtrace:\n"; - my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/; - - my ($A2L); - if (`uname -m` - =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) { - $A2L = "addr2line"; - } else { - $A2L = "i386-elf-addr2line"; - } - open (A2L, "$A2L -fe pintos/src/userprog/build/kernel.o @addrs|"); - for (;;) { - my ($function, $line); - last unless defined ($function = ); - $line = ; - chomp $function; - chomp $line; - $details .= " $function ($line)\n"; - } - } - $extra{$test} = $details; - die "Kernel panic. Details at end of file.\n" - } - - die "No output at all\n" if @output == 0; - die "Didn't start up properly: no \"Pintos booting\" startup message\n" - if !grep (/Pintos booting with.*kB RAM\.\.\./, @output); - die "Didn't start up properly: no \"Boot complete\" startup message\n" - if !grep (/Boot complete/, @output); - die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n" - if !grep (/Timer: \d+ ticks/, @output); - die "Didn't shut down properly: no \"Powering off\" shutdown message\n" - if !grep (/Powering off/, @output); -} - -# Get @output without header or trailer. -sub get_core_output { - my (@output) = @_; - - our ($test); - my ($first); - for ($first = 0; $first <= $#output; $first++) { - $first++, last if $output[$first] =~ /^Executing '$test.*':$/; - } - - my ($last); - for ($last = $#output; $last >= 0; $last--) { - $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/; - } - - if ($last < $first) { - my ($no_first) = $first > $#output; - my ($no_last) = $last < $#output; - die "Couldn't locate output.\n"; - } - - return @output[$first ... $last]; -} - -sub fix_exit_codes { - my (@output) = @_; - - # Fix up lines that look like exit codes. - for my $i (0...$#output) { - if (my ($process, $code) - = $output[$i] =~ /^([-a-zA-Z0-9 ]+):.*[ \(](-?\d+)\b\)?$/) { - $process = substr ($process, 0, 15); - $process =~ s/\s.*//; - $output[$i] = "$process: exit($code)\n"; - } - } - - return @output; -} - -sub compare_output { - my ($exp, @actual) = @_; - @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual))); - - my ($details) = ""; - $details .= "$test actual output:\n"; - $details .= join ('', map (" $_", @actual)); - - my (@exp) = map ("$_\n", snarf ($exp)); - - my ($fuzzy_match) = 0; - while (@exp != 0) { - my (@expected); - while (@exp != 0) { - my ($s) = shift (@exp); - last if $s eq "--OR--\n"; - push (@expected, $s); - } - - $details .= "\n$test acceptable output:\n"; - $details .= join ('', map (" $_", @expected)); - - # Check whether they're the same. - if ($#actual == $#expected) { - my ($eq) = 1; - for (my ($i) = 0; $i <= $#expected; $i++) { - $eq = 0 if $actual[$i] ne $expected[$i]; - } - return if $eq; - } - - # They differ. Output a diff. - my (@diff) = ""; - my ($d) = Algorithm::Diff->new (\@expected, \@actual); - my ($not_fuzzy_match) = 0; - while ($d->Next ()) { - my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2)); - if ($d->Same ()) { - push (@diff, map (" $_", $d->Items (1))); - } else { - push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1); - push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2); - if ($d->Items (1) - || grep (/\($test\)|exit\(-?\d+\)/, $d->Items (2))) { - $not_fuzzy_match = 1; - } - } - } - $fuzzy_match = 1 if !$not_fuzzy_match; - - $details .= "Differences in `diff -u' format:\n"; - $details .= join ('', @diff); - $details .= "(This is considered a `fuzzy match'.)\n" if $fuzzy_match; - } - - $details{$test} = $details; - die "Output differs from expected. Details at end of file.\n" - unless $fuzzy_match; -} - -sub write_grades { - my (@summary) = snarf ("$GRADES_DIR/tests.txt"); - - my ($ploss) = 0; - my ($tloss) = 0; - my ($total) = 0; - for (my ($i) = 0; $i <= $#summary; $i++) { - local ($_) = $summary[$i]; - if (my ($loss, $test) = /^ -(\d+) ([-a-zA-Z0-9]+):/) { - my ($result) = $result{$test} || "Not tested."; - - if ($result eq 'ok') { - splice (@summary, $i, 1); - $i--; - } else { - $ploss += $loss; - $tloss += $loss; - splice (@summary, $i + 1, 0, - map (" $_", split ("\n", $result))); - } - } elsif (my ($ptotal) = /^Score: \/(\d+)$/) { - $total += $ptotal; - $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal"; - splice (@summary, $i, 0, " All tests passed.") if $ploss == 0; - $ploss = 0; - $i++; - } - } - my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")"; - $summary[0] =~ s/\[\[total\]\]/$ts/; - - open (SUMMARY, ">tests.out"); - print SUMMARY map ("$_\n", @summary); - close (SUMMARY); -} - -sub write_details { - open (DETAILS, ">details.out"); - my ($n) = 0; - for my $test (@TESTS) { - next if $result{$test} eq 'ok' && !defined $details{$test}; - - my ($details) = $details{$test}; - next if !defined ($details) && ! -e "output/$test/run.out"; - - print DETAILS "\n" if $n++; - print DETAILS "--- $test details ", '-' x (50 - length ($test)); - print DETAILS "\n\n"; - - if (!defined $details) { - $details = "Output:\n\n" . snarf ("output/$test/run.out"); - } - print DETAILS $details; - - print DETAILS "\n", "-" x 10, "\n\n$extra{$test}" - if defined $extra{$test}; - } - close (DETAILS); - -} - -sub xsystem { - my ($command, %options) = @_; - print "$command\n" if $VERBOSE || $options{VERBOSE}; - - my ($log) = $options{LOG}; - if (defined ($log)) { - $command = "($command) >output/$log.out 2>output/$log.err"; - } - - my ($pid, $status); - eval { - local $SIG{ALRM} = sub { die "alarm\n" }; - alarm $options{TIMEOUT} if defined $options{TIMEOUT}; - $pid = fork; - die "fork: $!\n" if !defined $pid; - exec ($command), die "$command: exec: $!\n" if !$pid; - waitpid ($pid, 0); - $status = $?; - alarm 0; - }; - if ($@) { - die unless $@ eq "alarm\n"; # propagate unexpected errors - print "Timed out.\n"; - kill SIGTERM, $pid; - $status = 0; - } - - if (WIFSIGNALED ($status)) { - my ($signal) = WTERMSIG ($status); - die "Interrupted\n" if $signal == SIGINT; - print "Child terminated with signal $signal\n"; - } - - unlink ("output/$log.err") if defined ($log) && $status == 0; - - die $options{DIE} if $status != 0 && defined $options{DIE}; - - return $status == 0; -} - -sub snarf { - my ($file) = @_; - open (OUTPUT, $file) or die "$file: open: $!\n"; - my (@lines) = ; - chomp (@lines); - close (OUTPUT); - return wantarray ? @lines : join ('', map ("$_\n", @lines)); -} - -sub files_equal { - my ($a, $b) = @_; - my ($equal); - open (A, "<$a") or die "$a: open: $!\n"; - open (B, "<$b") or die "$b: open: $!\n"; - if (-s A != -s B) { - $equal = 0; - } else { - my ($sa, $sb); - for (;;) { - sysread (A, $sa, 1024); - sysread (B, $sb, 1024); - $equal = 0, last if $sa ne $sb; - $equal = 1, last if $sa eq ''; - } - } - close (A); - close (B); - return $equal; -} - -sub file_contains { - my ($file, $expected) = @_; - open (FILE, "<$file") or die "$file: open: $!\n"; - my ($actual); - sysread (FILE, $actual, -s FILE); - my ($equal) = $actual eq $expected; - close (FILE); - return $equal; -} - -sub number_lines { - my ($ln, $lines) = @_; - my ($out); - for my $line (@$lines) { - chomp $line; - $out .= sprintf "%4d %s\n", $ln++, $line; - } - return $out; + my ($result) = run_pintos ("pintos " + . "--os-disk=pintos/src/userprog/build/os.dsk " + . "--fs-disk=output/$test/fs.dsk.keep " + . "-v get $guest_fn $host_fn", + LOG => "$test/get-$guest_fn", + TIMEOUT => 10, + EXPECT => 0); + die "`pintos get $guest_fn' failed - $result\n" + if $result ne 'ok'; }