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.
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;
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;
}
# 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
# 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);
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) {
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
}
}
print "\n";
}
+ print "(empty)\n" if !@_;
}
# normalize_fs (%FS)
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;
# 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.
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';