X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=grading%2Fvm%2Frun-tests;h=fea0bfb9ccf12500642b0bc10cf888d12c6d2a47;hb=5780c9f434cca090f88463b7f0199d49b4ded288;hp=161a6a8cc52a9b56138c758d86f24e1c7ba6514f;hpb=849664a61f4c1458417dc6debcfb45e60d6c1475;p=pintos-anon diff --git a/grading/vm/run-tests b/grading/vm/run-tests index 161a6a8..fea0bfb 100755 --- a/grading/vm/run-tests +++ b/grading/vm/run-tests @@ -3,6 +3,7 @@ # Find the directory that contains the grading files. our ($GRADES_DIR); +# Add our Perl library directory to the include path. BEGIN { ($GRADES_DIR = $0) =~ s#/[^/]+$##; -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n"; @@ -11,771 +12,75 @@ BEGIN { use warnings; use strict; -use POSIX; -use Algorithm::Diff; -use Getopt::Long; +use Pintos::Grading; -our ($VERBOSE) = 0; # Verbosity of output +our ($hw) = "vm"; 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 (pt-grow-stack pt-big-stk-obj pt-bad-addr pt-write-code + page-linear page-parallel page-merge-seq page-merge-par + page-shuffle mmap-read mmap-close mmap-unmap mmap-overlap + mmap-twice mmap-write mmap-exit mmap-shuffle); -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 (pt-grow-stack pt-big-stk-obj pt-bad-addr pt-write-code - page-linear page-parallel page-merge-seq page-merge-par - page-shuffle mmap-read mmap-close mmap-unmap mmap-overlap - mmap-twice mmap-write mmap-exit mmap-shuffle - ) 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])); - } - } +clean_dir (), exit if $action eq 'clean'; - 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; -} - -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); -} +extract_sources (); +exit if $action eq 'extract'; -# Create output directory, if it doesn't already exist. --d ("output") || mkdir ("output") or die "output: mkdir: $!\n"; +build (); +exit if $action eq 'build'; -# 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; -} - -# 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"); - xsystem ("patch -fs pintos/src/lib/kernel/bitmap.c " - . "< $GRADES_DIR/random.diff", - LOG => "patch", - DIE => "patch failed\n"); +exit success () 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 success () 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/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"; + # Set up output directory. xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk", DIE => "cp failed\n"); xsystem ("pintos make-disk output/$test/swap.dsk 2 >/dev/null 2>&1", DIE => "failed to create swap disk"); # Run. - my ($timeout) = 600; - my ($testargs) = defined ($args{$test}) ? " $args{$test}" : ""; - xsystem ("pintos " - . "--os-disk=pintos/src/vm/build/os.dsk " - . "--fs-disk=output/$test/fs.dsk " - . "--swap-disk=output/$test/swap.dsk " - . "-v run -q -ex \"$test$testargs\"", - LOG => "$test/run", - TIMEOUT => $timeout, - EXPECT => 1) - or return "Bochs error"; - - return "ok"; -} - -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 (["--os-disk=pintos/src/vm/build/os.dsk", + "--fs-disk=output/$test/fs.dsk", + "--swap-disk=output/$test/swap.dsk", + "-v", "run", "-q", "-ex", "$test"], + LOG => "$test/run", + TIMEOUT => 600); } -sub grade_write_normal { - my (@output) = @_; - verify_common (@output); - compare_output ("$GRADES_DIR/write-normal.exp", @output); - my ($test_txt) = "output/$test/test.txt"; - get_file ("test.txt", $test_txt) if ! -e $test_txt; - - my (@actual) = snarf ($test_txt); - my (@expected) = snarf ("$GRADES_DIR/sample.txt"); - - my ($eq); - if ($#actual == $#expected) { - $eq = 1; - for my $i (0...$#actual) { - $eq = 0 if $actual[$i] ne $expected[$i]; - } - } else { - $eq = 0; - } - if (!$eq) { - my ($details); - $details = "Expected file content:\n"; - $details .= join ('', map (" $_\n", @expected)); - $details .= "Actual file content:\n"; - $details .= join ('', map (" $_\n", @actual)); - $extra{$test} = $details; - - die "File written didn't have expected content.\n"; - } -} +sub grade_process_death { + my ($proc_name, @output) = @_; -sub grade_multi_oom { - my (@output) = @_; verify_common (@output); - - @output = fix_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 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 !/^\(multi-oom\) end $n$/; - - 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/vm/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/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; - } - - unlink ("output/$log.err") if defined ($log) && $ok; - - die $options{DIE} if !$ok && defined $options{DIE}; - - 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)); + @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 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 grade_pt_bad_addr { + grade_process_death ('pt-bad-addr', @_); } -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 grade_pt_write_code { + grade_process_death ('pt-write-code', @_); } -sub number_lines { - my ($ln, $lines) = @_; - my ($out); - for my $line (@$lines) { - chomp $line; - $out .= sprintf "%4d %s\n", $ln++, $line; - } - return $out; +sub grade_mmap_unmap { + grade_process_death ('mmap-unmap', @_); }