X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=grading%2Flib%2FPintos%2FGrading.pm;h=463d475eada79a590a1241847c24778a754c1698;hb=9fd03907adce1d0e3e31a8ce6be3e1547434ce40;hp=d48b2751c92219f4a1b55f3771d0e2a9cc657cd0;hpb=fbea5921d53e698fee2014995cdb13ddb67a982f;p=pintos-anon

diff --git a/grading/lib/Pintos/Grading.pm b/grading/lib/Pintos/Grading.pm
index d48b275..463d475 100644
--- a/grading/lib/Pintos/Grading.pm
+++ b/grading/lib/Pintos/Grading.pm
@@ -16,6 +16,11 @@ use POSIX;
 use Getopt::Long qw(:config no_ignore_case);
 use Algorithm::Diff;
 
+# 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,
@@ -311,7 +316,13 @@ sub xsystem {
 		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);
@@ -340,12 +351,9 @@ sub xsystem {
 	    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)) {
@@ -397,10 +405,15 @@ sub get_test_result {
 
 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;
 }
@@ -408,7 +421,16 @@ sub run_pintos {
 # Grade the test.
 sub grade_test {
     # Read test output.
-    my (@output) = snarf ("output/$test/run.out");
+    my ($outfile) = "output/$test/run.out";
+    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.";
+	}
+	die "$outfile: missing test output file";
+    }
+    my (@output) = snarf ($outfile);
 
     # If there's a function "grade_$test", use it to evaluate the output.
     # If there's a file "$GRADES_DIR/$test.exp", compare its contents
@@ -825,5 +847,12 @@ sub file_contains {
     close (FILE);
     return $equal;
 }
+
+sub success {
+    for my $test (@TESTS) {
+	return 1 if !defined ($result{$test}) || $result{$test} ne 'ok';
+    }
+    return 0;
+}
 
 1;