use Getopt::Long qw(:config no_ignore_case);
use Algorithm::Diff;
\f
+# We execute lots of subprocesses.
+# Without this, our stdout output can get flushed multiple times,
+# which is harmless but looks bizarre.
+$| = 1;
+
sub parse_cmd_line {
my ($do_regex, $no_regex);
GetOptions ("v|verbose+" => \$verbose,
\f
# Source tarballs.
-# Extracts the group's source files into pintos/src,
-# applies any patches providing in the grading directory,
-# and installs a default pintos/src/constants.h
+# Extracts the group's source files into pintos/src
+# and applies any patches providing in the grading directory.
sub extract_sources {
# Make sure the output dir exists.
-d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
xsystem ("patch -fs -p0 < $patch",
LOG => $stem, DIE => "applying patch $stem failed\n");
}
-
- # Install default pintos/src/constants.h.
- open (CONSTANTS, ">pintos/src/constants.h")
- or die "constants.h: create: $!\n";
- print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
- close CONSTANTS;
}
# Returns the name of the tarball to extract.
open (STDOUT, ">output/$log.out");
open (STDERR, ">output/$log.err");
}
- exec ($command);
+ chdir $options{CHDIR} or die "$options{CHDIR}: chdir: $!\n"
+ if defined ($options{CHDIR});
+ if (!defined ($options{EXEC})) {
+ exec ($command);
+ } else {
+ exec (@{$options{EXEC}});
+ }
exit (-1);
}
waitpid ($pid, 0);
print "Child terminated with signal $signal\n";
}
- my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
- $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
- ? "ok" : "error";
+ $result = $status == 0 ? "ok" : "error";
}
-
if ($result eq 'error' && defined $options{DIE}) {
my ($msg) = $options{DIE};
if (defined ($log)) {
sub run_pintos {
my ($cmd_line, %args) = @_;
- $args{EXPECT} = 1 unless defined $args{EXPECT};
- my ($retval) = xsystem ($cmd_line, %args);
+ unshift (@$cmd_line, 'pintos');
+ my ($retval) = xsystem (join (' ', @$cmd_line), %args, EXEC => $cmd_line);
return 'ok' if $retval eq 'ok';
- return "Timed out after $args{TIMEOUT} seconds" if $retval eq 'timeout';
+ if ($retval eq 'timeout') {
+ my ($msg) = "Timed out after $args{TIMEOUT} seconds";
+ my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
+ $msg .= " - $load_avg" if defined $load_avg;
+ return $msg;
+ }
return 'Error running Bochs' if $retval eq 'error';
die;
}
sub grade_test {
# Read test output.
my ($outfile) = "output/$test/run.out";
- die "$outfile: missing test output file (make failed?)" if ! -e $outfile;
+ if (! -e $outfile) {
+ if (-s "output/$test/make.err") {
+ # make failed.
+ $details{$test} = snarf ("output/$test/make.err");
+ return "make failed. Error messages at end of file.";
+ }
+ return "preparation for test failed";
+ }
my (@output) = snarf ($outfile);
# If there's a function "grade_$test", use it to evaluate the output.
close (FILE);
return $equal;
}
+\f
+sub success {
+ for my $test (@TESTS) {
+ return 1 if !defined ($result{$test}) || $result{$test} ne 'ok';
+ }
+ return 0;
+}
1;