Use standard POSIX "ustar" format for the scratch disk.

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

diff --git a/src/tests/tests.pm b/src/tests/tests.pm
index 74b69054936205970c150197bcfd1f023f45f79a..4599cb98fe49d7627173d182f48ce2ef072f03ab 100644 (file)
--- a/src/tests/tests.pm
+++ b/src/tests/tests.pm
@@ -12,6 +12,16 @@ our ($test, $src_dir) = @ARGV;
 
 my ($msg_file) = tempfile ();
 select ($msg_file);
+
+our (@prereq_tests) = ();
+if ($test =~ /^(.*)-persistence$/) {
+    push (@prereq_tests, $1);
+}
+for my $prereq_test (@prereq_tests) {
+    my (@result) = read_text_file ("$prereq_test.result");
+    fail "Prerequisite test $prereq_test failed.\n" if $result[0] ne 'PASS';
+}
+
 \f
 # Generic testing.
 
@@ -112,6 +122,8 @@ sub check_for_triple_fault {
     print <<EOF;
 \u$run spontaneously rebooted $reboots times.
 This is most often caused by unhandled page faults.
+Read the Triple Faults section in the Debugging chapter
+of the Pintos manual for more information.
 EOF
 
     fail;
@@ -149,9 +161,21 @@ sub compare_output {
     my (@output) = get_core_output ($run, @$output);
     fail "\u$run didn't produce any output" if !@output;
 
-    if (exists $options{IGNORE_EXIT_CODES}) {
+    my $ignore_exit_codes = exists $options{IGNORE_EXIT_CODES};
+    if ($ignore_exit_codes) {
        delete $options{IGNORE_EXIT_CODES};
-       @output = grep (!/^[a-zA-Z0-9-_]+: exit\(\d+\)$/, @output);
+       @output = grep (!/^[a-zA-Z0-9-_]+: exit\(\-?\d+\)$/, @output);
+    }
+    my $ignore_user_faults = exists $options{IGNORE_USER_FAULTS};
+    if ($ignore_user_faults) {
+       delete $options{IGNORE_USER_FAULTS};
+       @output = grep (!/^Page fault at.*in user context\.$/
+                       && !/: dying due to interrupt 0x0e \(.*\).$/
+                       && !/^Interrupt 0x0e \(.*\) at eip=/
+                       && !/^ cr2=.* error=.*/
+                       && !/^ eax=.* ebx=.* ecx=.* edx=.*/
+                       && !/^ esi=.* edi=.* esp=.* ebp=.*/
+                       && !/^ cs=.* ds=.* es=.* ss=.*/, @output);
     }
     die "unknown option " . (keys (%options))[0] . "\n" if %options;
 
@@ -196,6 +220,10 @@ sub compare_output {
     }
 
     # Failed to match.  Report failure.
+    $msg .= "\n(Process exit codes are excluded for matching purposes.)\n"
+      if $ignore_exit_codes;
+    $msg .= "\n(User fault messages are excluded for matching purposes.)\n"
+      if $ignore_user_faults;
     fail "Test output failed to match any acceptable form.\n\n$msg";
 }
 \f
@@ -217,7 +245,8 @@ sub compare_output {
 #         recursively.
 sub check_archive {
     my ($expected_hier) = @_;
-    my (@output) = read_text_file ("$test.get-output");
+
+    my (@output) = read_text_file ("$test.output");
     common_checks ("file system extraction run", @output);
 
     @output = get_core_output ("file system extraction run", @output);
@@ -226,11 +255,12 @@ sub check_archive {
 
     my ($test_base_name) = $test;
     $test_base_name =~ s%.*/%%;
-    $expected_hier->{$test_base_name} = $test;
+    $test_base_name =~ s%-persistence$%%;
+    $expected_hier->{$test_base_name} = $prereq_tests[0];
     $expected_hier->{'tar'} = 'tests/filesys/extended/tar';
 
     my (%expected) = normalize_fs (flatten_hierarchy ($expected_hier, ""));
-    my (%actual) = read_tar ("$test.tar");
+    my (%actual) = read_tar ("$prereq_tests[0].tar");
 
     my ($errors) = 0;
     foreach my $name (sort keys %expected) {
@@ -255,7 +285,7 @@ sub check_archive {
                my ($esc_name) = $name;
                $esc_name =~ s/[^[:print:]]/./g;
                print <<EOF;
-$esc_name exists in the file system but should not.  (The expected name
+$esc_name exists in the file system but should not.  (The name
 of this file contains unusual characters that were printed as `.'.)
 EOF
            }
@@ -426,6 +456,7 @@ sub print_fs {
        }
        print "\n";
     }
+    print "(empty)\n" if !@_;
 }
 
 # normalize_fs (%FS)
@@ -492,12 +523,12 @@ sub flatten_hierarchy {
 sub read_tar {
     my ($archive) = @_;
     my (%content);
-    open (ARCHIVE, '<', $archive) or die "$archive: open: $1\n";
+    open (ARCHIVE, '<', $archive) or fail "$archive: open: $!\n";
     for (;;) {
        my ($header);
        if ((my $retval = sysread (ARCHIVE, $header, 512)) != 512) {
-           die "$archive: unexpected end of file\n" if $retval >= 0;
-           die "$archive: read: $!\n";
+           fail "$archive: unexpected end of file\n" if $retval >= 0;
+           fail "$archive: read: $!\n";
        }
 
        last if $header eq "\0" x 512;
@@ -505,37 +536,40 @@ sub read_tar {
        # Verify magic numbers.
        if (substr ($header, 257, 6) ne "ustar\0"
            || substr ($header, 263, 2) ne '00') {
-           die "$archive: corrupt ustar header\n";
+           fail "$archive: corrupt ustar header\n";
        }
 
        # Verify checksum.
        my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8, ' ' x 8)));
        my ($correct_chksum) = unpack ("%32a*", $header);
-       die "$archive: bad header checksum\n" if $chksum != $correct_chksum;
+       fail "$archive: bad header checksum\n" if $chksum != $correct_chksum;
 
        # Get file name.
        my ($name) = unpack ("Z100", $header);
        my ($prefix) = unpack ("Z*", substr ($header, 345));
        $name = "$prefix/$name" if $prefix ne '';
-       die "$archive: contains file with empty name" if $name eq '';
+       fail "$archive: contains file with empty name" if $name eq '';
 
        # Get type.
        my ($typeflag) = substr ($header, 156, 1);
        $typeflag = '0' if $typeflag eq "\0";
-       die "unknown file type '$typeflag'\n" if $typeflag !~ /[05]/;
+       fail "unknown file type '$typeflag'\n" if $typeflag !~ /[05]/;
 
        # Get size.
        my ($size) = oct (unpack ("Z*", substr ($header, 124, 12)));
-       die "bad size $size\n" if $size < 0;
+       fail "bad size $size\n" if $size < 0;
        $size = 0 if $typeflag eq '5';
 
        # Store content.
+       $name =~ s%^(/|\./|\.\./)*%%;   # Strip leading "/", "./", "../".
+       $name = '' if $name eq '.' || $name eq '..';
        if (exists $content{$name}) {
-           die "$archive: contains multiple entries for $name\n";
+           fail "$archive: contains multiple entries for $name\n";
        }
        if ($typeflag eq '5') {
-           $content{$name} = 'directory';
+           $content{$name} = 'directory' if $name ne '';
        } else {
+           fail "$archive: contains file with empty name\n" if $name eq '';
            my ($position) = sysseek (ARCHIVE, 0, SEEK_CUR);
            $content{$name} = [$archive, $position, $size];
            sysseek (ARCHIVE, int (($size + 511) / 512) * 512, SEEK_CUR);