Improve automatic test failure interpretation by extending backtrace

[pintos-anon] / src / tests / tests.pm

diff --git a/src/tests/tests.pm b/src/tests/tests.pm
index c2a5c64d8319ecd9b1314fcae1321802d1a8d409..858d8a4b50c58e1698bc5181024ea3a5bf012ada 100644 (file)
--- a/src/tests/tests.pm
+++ b/src/tests/tests.pm
@@ -1,17 +1,16 @@
 use strict;
 use warnings;
 use tests::Algorithm::Diff;
+use File::Temp 'tempfile';
 
 sub fail;
 sub pass;
 
 die if @ARGV != 2;
 our ($test, $src_dir) = @ARGV;
-our ($src_stem) = "$src_dir/$test";
 
-our ($messages) = "";
-open (MESSAGES, '>', \$messages);
-select (MESSAGES);
+my ($msg_file) = tempfile ();
+select ($msg_file);
 
 sub check_expected {
     my ($expected) = pop @_;
@@ -51,10 +50,27 @@ sub check_for_panic {
 
     my (@stack_line) = grep (/Call stack:/, @output);
     if (@stack_line != 0) {
-       my (@addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
-       print "Call stack: @addrs\n";
+       my ($addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
+
+       # Find a user program to translate user virtual addresses.
+       my ($userprog) = "";
+       $userprog = "$test"
+         if grep (hex ($_) < 0xc0000000, split (' ', $addrs)) > 0 && -e $test;
+
+       # Get and print the backtrace.
+       my ($trace) = scalar (`backtrace kernel.o $userprog $addrs`);
+       print "Call stack:$addrs\n";
        print "Translation of call stack:\n";
-       print `backtrace kernel.o @addrs`;
+       print $trace;
+
+       # Print disclaimer.
+       if ($userprog ne '' && index ($trace, $userprog) >= 0) {
+           print <<EOF;
+Translations of user virtual addresses above are based on a guess at
+the binary to use.  If this guess is incorrect, then those
+translations will be misleading.
+EOF
+       }
     }
 
     if ($panic =~ /sec_no \< d-\>capacity/) {
@@ -80,12 +96,6 @@ sub check_for_keyword {
     $kw_line =~ s/^\([^\)]+\)\s+//;
     print "$kw_line\n";
 
-    # Append output, eliminating uninteresting header and trailer info
-    # if possible.
-    my (@core) = get_core_output (@output);
-    @output = @core if @core;
-    print "Program output:\n\n" . join ('', map ("$_\n", @output));
-
     fail;
 }
 
@@ -96,18 +106,9 @@ sub check_for_triple_fault {
 
     print <<EOF;
 Pintos spontaneously rebooted during this test.
-This is most often caused by unhandled page faults.  Output from
-initial boot through the first reboot is shown below:
-
+This is most often caused by unhandled page faults.
 EOF
 
-    my ($i) = 0;
-    local ($_);
-    for (@output) {
-       print "  $_\n";
-       last if /Pintos booting/ && ++$i > 1;
-    }
-
     fail;
 }
 
@@ -133,13 +134,13 @@ sub compare_output {
     }
     die "unknown option " . (keys (%options))[0] . "\n" if %options;
 
-    my ($msg) = "Actual output:\n" . join ('', map ("  $_\n", @output));
+    my ($msg);
 
     # Compare actual output against each allowed output.
     foreach my $exp_string (@$expected) {
        my (@expected) = split ("\n", $exp_string);
 
-       $msg .= "\nAcceptable output:\n";
+       $msg .= "Acceptable output:\n";
        $msg .= join ('', map ("  $_\n", @expected));
 
        # Check whether actual and expected match.
@@ -184,6 +185,13 @@ sub pass {
 sub finish {
     my ($verdict, @rest) = @_;
 
+    my ($messages) = "";
+    seek ($msg_file, 0, 0);
+    while (<$msg_file>) {
+       $messages .= $_;
+    }
+    close ($msg_file);
+
     my ($result_fn) = "$test.result";
     open (RESULT, '>', $result_fn) or die "$result_fn: create: $!\n";
     print RESULT "$verdict\n", $messages, @rest;