X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=grading%2Ffilesys%2Frun-tests;h=7251cef06c412b4f2052ef63cf4feb2c92ea6e46;hb=415941c1e0a6fc5ce263d8355fde980239c0f844;hp=09c334c561a1c3b463e1199db1ec37526f314653;hpb=0f5c19ccf179b35b39ae46dffec60592baeeec00;p=pintos-anon diff --git a/grading/filesys/run-tests b/grading/filesys/run-tests index 09c334c..7251cef 100755 --- a/grading/filesys/run-tests +++ b/grading/filesys/run-tests @@ -12,254 +12,51 @@ BEGIN { use warnings; use strict; -use POSIX; -use Algorithm::Diff; -use Getopt::Long; +use Pintos::Grading; -our ($verbose) = 0; # Verbosity of output +our ($hw) = "filesys"; our (@TESTS); # Tests to run. -my ($clean) = 0; -my ($grade) = 0; +our ($test); +our ($action); -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; +parse_cmd_line qw (sm-create sm-full sm-seq-block sm-seq-random sm-random -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 - ) 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"; + lg-create lg-full lg-seq-block lg-seq-random lg-random - print OUT map ("$_\n", @tests), "\n"; - print OUT map ("$_\n", @review), "\n"; + 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 - print OUT "DETAILS\n"; - print OUT "-------\n\n"; - print OUT map ("$_\n", snarf ("details.out")); + 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 - exit 0; -} - -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); -} + syn-remove syn-read syn-write syn-rw); -# Create output directory, if it doesn't already exist. --d ("output") || mkdir ("output") or die "output: mkdir: $!\n"; +clean_dir (), exit if $action eq 'clean'; -# Extract submission. -extract_tarball () if ! -d "pintos"; +extract_sources (); +exit if $action eq 'extract'; -# 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; -} +build (); +exit success () if $action eq 'build'; -# Write output. -write_grades (); +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"); - - if (-e "fixme.sh") { - print "Running fixme.sh...\n"; - xsystem ("sh -e fixme.sh", DIE => "fix script failed\n"); - } - - print "Patching...\n"; - xsystem ("patch -fs pintos/src/lib/debug.c < $GRADES_DIR/panic.diff", - LOG => "patch", - DIE => "patch failed\n"); - - open (CONSTANTS, ">pintos/src/constants.h") - or die "constants.h: create: $!\n"; - print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n"; - close CONSTANTS; -} +exit success () if $action eq 'test'; -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; - } + my ($result); - # 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/vm && 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"; 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"); @@ -269,486 +66,65 @@ sub really_run_test { # Format disk, install test. my ($pintos_base_cmd) = "pintos " - . "--os-disk=pintos/src/vm/build/os.dsk " + . "--os-disk=pintos/src/$hw/build/os.dsk " . "--fs-disk=output/$test/fs.dsk " . "--swap-disk=output/$test/swap.dsk " . "-v"; - unlink ("output/$test/fs.dsk", "output/$test/swap.dsk"), - return "format/put error" - if !xsystem ("$pintos_base_cmd put -f $GRADES_DIR/$test $test", - LOG => "$test/put", TIMEOUT => 60, EXPECT => 1); + $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) { - return "format/put error" - if !xsystem ("$pintos_base_cmd put $GRADES_DIR/$fn $fn", - LOG => "$test/put-$fn", TIMEOUT => 60, EXPECT => 1); + $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'; } # Run. - my ($timeout) = 60; - my ($testargs) = defined ($args{$test}) ? " $args{$test}" : ""; - my ($result) = - xsystem ("$pintos_base_cmd run -q -ex \"$test$testargs\"", - LOG => "$test/run", TIMEOUT => $timeout, EXPECT => 1) - ? "ok" : "Bochs error"; - unlink ("output/$test/fs.dsk", "output/$test/swap.dsk"); - return $result; -} - -sub grade_test { - my ($test) = @_; - - 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"; + return run_pintos ("$pintos_base_cmd run -q -ex \"$test\"", + LOG => "$test/run", TIMEOUT => 120); } - -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/vm/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) = @_; - - 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) = @_; - - # 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; - } - - 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"; - } - - $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 ($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"; - - 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 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 xsystem { - my ($command, %options) = @_; - print "$command\n" if $verbose || $options{VERBOSE}; - - my ($log) = $options{LOG}; - - 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; - if (!$pid) { - if (defined $log) { - open (STDOUT, ">output/$log.out"); - open (STDERR, ">output/$log.err"); - } - exec ($command); - exit (-1); - } - waitpid ($pid, 0); - $status = $?; - alarm 0; - }; - - my ($ok); - if ($@) { - die unless $@ eq "alarm\n"; # propagate unexpected errors - print "Timed out: "; - for (my ($i) = 0; $i < 10; $i++) { - kill ('SIGTERM', $pid); - sleep (1); - my ($retval) = waitpid ($pid, WNOHANG); - last if $retval == $pid || $retval == -1; - print "Waiting for $pid to die" if $i == 0; - print "."; - } - $ok = 1; - } else { - if (WIFSIGNALED ($status)) { - my ($signal) = WTERMSIG ($status); - die "Interrupted\n" if $signal == SIGINT; - print "Child terminated with signal $signal\n"; - } - - my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT}; - $ok = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status; + 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 (!$ok && defined $options{DIE}) { - my ($msg) = $options{DIE}; - if (defined ($log)) { - chomp ($msg); - $msg .= "; see output/$log.err and output/$log.out for details\n"; - } - die $msg; - } elsif (defined ($log) && $ok) { - unlink ("output/$log.err"); + 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; - return $ok; -} - -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 ''; - } + 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}++; } - 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; + 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 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 (@_); }