X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=grading%2Ffilesys%2Frun-tests;h=7251cef06c412b4f2052ef63cf4feb2c92ea6e46;hb=415941c1e0a6fc5ce263d8355fde980239c0f844;hp=d683f7ce1103d93b5fb59cf08c8618c4e550e871;hpb=f7329f3d75dd5db7fd1bde03ed3c8a13b285eb7e;p=pintos-anon diff --git a/grading/filesys/run-tests b/grading/filesys/run-tests index d683f7c..7251cef 100755 --- a/grading/filesys/run-tests +++ b/grading/filesys/run-tests @@ -1,7 +1,7 @@ #! /usr/bin/perl # Find the directory that contains the grading files. -use vars qw($GRADES_DIR); +our ($GRADES_DIR); # Add our Perl library directory to the include path. BEGIN { @@ -12,533 +12,119 @@ BEGIN { use warnings; use strict; -use POSIX; -use Algorithm::Diff; -use Getopt::Long; use Pintos::Grading; -our ($test); -our ($verbose) = 0; # Verbosity of output +our ($hw) = "filesys"; 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 (sm-create sm-full sm-seq-block sm-seq-random sm-random - - grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell - grow-sparse grow-too-big grow-root-sm grow-root-lg grow-dir-lg - grow-two-files - - dir-mkdir dir-rmdir dir-mk-vine dir-rm-vine dir-mk-tree - dir-rm-tree dir-lsdir dir-rm-cwd dir-rm-cwd-cd - dir-rm-parent dir-rm-root dir-over-file dir-under-file - dir-empty-name dir-open - - syn-remove syn-read syn-write syn-rw - ) unless @TESTS > 0; - -our (%args); - -# 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"; +our ($test); +our ($action); - print OUT map ("$_\n", @tests), "\n"; - print OUT map ("$_\n", @review), "\n"; +parse_cmd_line qw (sm-create sm-full sm-seq-block sm-seq-random sm-random - print OUT "DETAILS\n"; - print OUT "-------\n\n"; - print OUT map ("$_\n", snarf ("details.out")); + lg-create lg-full lg-seq-block lg-seq-random lg-random - exit 0; -} + grow-create grow-seq-sm grow-seq-lg grow-file-size grow-tell + grow-sparse grow-too-big grow-root-sm grow-root-lg + grow-dir-lg grow-two-files -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); -} + dir-mkdir dir-rmdir dir-mk-vine dir-rm-vine dir-mk-tree + dir-rm-tree dir-lsdir dir-rm-cwd dir-rm-cwd-cd + dir-rm-parent dir-rm-root dir-over-file dir-under-file + dir-empty-name dir-open -# Create output directory, if it doesn't already exist. --d ("output") || mkdir ("output") or die "output: mkdir: $!\n"; + syn-remove syn-read syn-write syn-rw); -# Extract submission. -obtain_sources (); +clean_dir (), exit if $action eq 'clean'; -# Compile submission. -compile (); +extract_sources (); +exit if $action eq 'extract'; -# Verify that the proper directory was submitted. --d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n"; +build (); +exit success () if $action eq 'build'; -# Run and grade the tests. -our %result; -our %details; -our %extra; -for $test (@TESTS) { - print "$test: "; - my ($result) = get_test_result (); - if ($result eq 'ok') { - $result = grade_test ($test); - } elsif ($result =~ /^Timed out/) { - $result = "$result - " . grade_test ($test); +run_and_grade_tests (); +write_grades (); +write_details (); +exit success () if $action eq 'test'; + +assemble_final_grade (); +exit if $action eq 'assemble'; + +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 ($result); + + my ($fs_size) = $test ne 'grow-too-big' ? 2 : .25; + xsystem ("pintos make-disk output/$test/fs.dsk $fs_size >/dev/null 2>&1", + DIE => "failed to create file system disk"); + xsystem ("pintos make-disk output/$test/swap.dsk 2 >/dev/null 2>&1", + DIE => "failed to create swap disk"); + + # Format disk, install test. + my ($pintos_base_cmd) = + "pintos " + . "--os-disk=pintos/src/$hw/build/os.dsk " + . "--fs-disk=output/$test/fs.dsk " + . "--swap-disk=output/$test/swap.dsk " + . "-v"; + $result = run_pintos ("$pintos_base_cmd put -f $GRADES_DIR/$test $test", + LOG => "$test/put", TIMEOUT => 60); + return $result if $result ne 'ok'; + + my (@extra_files); + push (@extra_files, "child-syn-read") if $test eq 'syn-read'; + push (@extra_files, "child-syn-wrt") if $test eq 'syn-write'; + push (@extra_files, "child-syn-rw") if $test eq 'syn-rw'; + for my $fn (@extra_files) { + $result = run_pintos ("$pintos_base_cmd put $GRADES_DIR/$fn $fn", + LOG => "$test/put-$fn", TIMEOUT => 60); + return "Error running `put $fn': $result" if $result ne 'ok'; } - chomp ($result); - print "$result"; - print " - with warnings" if $result eq 'ok' && defined $details{$test}; - print "\n"; - $result{$test} = $result; + # Run. + return run_pintos ("$pintos_base_cmd run -q -ex \"$test\"", + LOG => "$test/run", TIMEOUT => 120); } -# Write output. -write_grades (); -write_details (); - - -sub grade_process_death { - my ($proc_name, @output) = @_; - +sub grade_dir_lsdir { + my (@output) = @_; verify_common (@output); @output = get_core_output (@output); - die "First line of output is not `($proc_name) begin' message.\n" - if $output[0] ne "($proc_name) begin"; - die "Output contains `FAIL' message.\n" - if grep (/FAIL/, @output); - die "Output contains spurious ($proc_name) message.\n" - if grep (/\($proc_name\)/, @output) > 1; -} - -sub grade_pt_bad_addr { - grade_process_death ('pt-bad-addr', @_); -} - -sub grade_pt_write_code { - grade_process_death ('pt-write-code', @_); -} - -sub grade_mmap_unmap { - grade_process_death ('mmap-unmap', @_); -} - -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/filesys/build/kernel.o @addrs|"); - for (;;) { - my ($function, $line); - last unless defined ($function = ); - $line = ; - chomp $function; - chomp $line; - $details .= " $function ($line)\n"; - } - } - - if ($assertion[0] =~ /sec_no < d->capacity/) { - $details .= < 1) { - my ($details); - - $details = "Pintos spontaneously rebooted during this test.\n"; - $details .= "This is most often due to unhandled page faults.\n"; - $details .= "Here's the output from the initial boot through the\n"; - $details .= "first reboot:\n\n"; - - my ($i) = 0; - local ($_); - for (@output) { - $details .= " $_\n"; - last if /Pintos booting/ && ++$i > 1; - } - $details{$test} = $details; - die "Triple-fault caused spontaneous reboot(s). " - . "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) = @_; - - 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) = @_; - - # Remove lines that look like exit codes. - # Exit codes are supposed to be printed in the form "process: exit(code)" - # but people get unfortunately creative with it. - for (my ($i) = 0; $i <= $#output; $i++) { - local ($_) = $output[$i]; - - my ($process, $code); - if ((($process, $code) = /^([-a-z0-9 ]+):.*[ \(](-?\d+)\b\)?$/) - || (($process, $code) = /^([-a-z0-9 ]+) exit\((-?\d+)\)$/) - || (($process, $code) - = /^([-a-z0-9 ]+) \(.*\): exit\((-?\d+)\)$/) - || (($process, $code) = /^([-a-z0-9 ]+):\( (-?\d+) \) $/) - || (($code, $process) = /^shell: exit\((-?\d+)\) \| ([-a-z0-9]+)/) - ) { - splice (@output, $i, 1); - $i--; - } - } - - return @output; -} - -sub compare_output { - my ($exp, @actual) = @_; - @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual))); - die "Program produced no output.\n" if !@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+\)|dying due to|Page fault/, - $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 !$not_fuzzy_match; + my ($begin); + for my $i (0...$#output) { + $begin = $i, last if $output[$i] eq '(dir-lsdir) begin'; } + die "\"(dir-lsdir) begin\" does not appear in output\n" if !defined $begin; - if ($fuzzy_match) { - $details = - "This test passed, but with extra, unexpected output.\n" - . "Please inspect your code to make sure that it does not\n" - . "produce output other than as specified in the project\n" - . "description.\n\n" - . "$details"; - } else { - $details = - "This test failed because its output did not match any\n" - . "of the acceptable form(s).\n\n" - . "$details"; + my ($end); + for my $i (0...$#output) { + $end = $i, last if $output[$i] eq '(dir-lsdir) end'; } + die "\"(dir-lsdir) end\" does not appear in output\n" if !defined $end; + die "\"begin\" follows \"end\" in output\n" if $begin > $end; - $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; - my ($warnings) = 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') { - if (!defined $details{$test}) { - # Test successful and no warnings. - splice (@summary, $i, 1); - $i--; - } else { - # Test successful with warnings. - s/-(\d+) //; - $summary[$i] = $_; - splice (@summary, $i + 1, 0, - " Test passed with warnings. " - . "Details at end of file."); - $warnings++; - } - } 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 && !$warnings; - $ploss = 0; - $warnings = 0; - $i++; - } + my (%count); + for my $fn (@output[$begin + 1...$end - 1]) { + $fn =~ s/\s+$//; + die "Unexpected file \"$fn\" in lsdir output\n" + unless grep ($_ eq $fn, qw (. .. dir-lsdir)); + die "File \"$fn\" listed twice in lsdir output\n" + if $count{$fn}; + $count{$fn}++; } - my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")"; - $summary[0] =~ s/\[\[total\]\]/$ts/; - - open (SUMMARY, ">tests.out"); - print SUMMARY map ("$_\n", @summary); - close (SUMMARY); + die "No files in lsdir output\n" if scalar (keys (%count)) == 0; + die "File \"dir-lsdir\" missing from lsdir output\n" + if !$count{"dir-lsdir"}; } -sub write_details { - open (DETAILS, ">details.out"); - my ($n) = 0; - for $test (@TESTS) { - next if $result{$test} eq 'ok' && !defined $details{$test}; - - my ($details) = $details{$test}; - next if !defined ($details) && ! -e "output/$test/run.out"; - - my ($banner); - if ($result{$test} ne 'ok') { - $banner = "$test failure details"; - } else { - $banner = "$test warnings"; - } - - print DETAILS "\n" if $n++; - print DETAILS "--- $banner ", '-' x (50 - length ($banner)); - print DETAILS "\n\n"; - - if (!defined $details) { - my (@output) = snarf ("output/$test/run.out"); - - # Print only the first in a series of recursing panics. - my ($panic) = 0; - for my $i (0...$#output) { - local ($_) = $output[$i]; - if (/PANIC/ && $panic++ > 0) { - @output = @output[0...$i]; - push (@output, - "[...details of recursive panic(s) omitted...]"); - last; - } - } - $details = "Output:\n\n" . join ('', map ("$_\n", @output)); - } - print DETAILS $details; - - print DETAILS "\n", "-" x 10, "\n\n$extra{$test}" - if defined $extra{$test}; - } - close (DETAILS); - -} - -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; +# This should be improved, but none of the fall 2004 submissions +# survived the test! +# I suppose it could be a bug in the test but a lot of the submissions +# had kernel panics, etc. +sub grade_syn_rw { + verify_common (@_); }