3 use tests::Algorithm::Diff;
4 use File::Temp 'tempfile';
5 use Fcntl qw(SEEK_SET SEEK_CUR);
11 our ($test, $src_dir) = @ARGV;
13 my ($msg_file) = tempfile ();
19 my ($expected) = pop @_;
21 my (@output) = read_text_file ("$test.output");
22 common_checks ("run", @output);
23 compare_output ("run", @options, \@output, $expected);
27 my ($run, @output) = @_;
29 fail "\u$run produced no output at all\n" if @output == 0;
31 check_for_panic ($run, @output);
32 check_for_keyword ($run, "FAIL", @output);
33 check_for_triple_fault ($run, @output);
34 check_for_keyword ($run, "TIMEOUT", @output);
36 fail "\u$run didn't start up properly: no \"Pintos booting\" message\n"
37 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
38 fail "\u$run didn't start up properly: no \"Boot complete\" message\n"
39 if !grep (/Boot complete/, @output);
40 fail "\u$run didn't shut down properly: no \"Timer: # ticks\" message\n"
41 if !grep (/Timer: \d+ ticks/, @output);
42 fail "\u$run didn't shut down properly: no \"Powering off\" message\n"
43 if !grep (/Powering off/, @output);
47 my ($run, @output) = @_;
49 my ($panic) = grep (/PANIC/, @output);
50 return unless defined $panic;
52 print "Kernel panic in $run: ", substr ($panic, index ($panic, "PANIC")),
55 my (@stack_line) = grep (/Call stack:/, @output);
56 if (@stack_line != 0) {
57 my ($addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
59 # Find a user program to translate user virtual addresses.
62 if grep (hex ($_) < 0xc0000000, split (' ', $addrs)) > 0 && -e $test;
64 # Get and print the backtrace.
65 my ($trace) = scalar (`backtrace kernel.o $userprog $addrs`);
66 print "Call stack:$addrs\n";
67 print "Translation of call stack:\n";
71 if ($userprog ne '' && index ($trace, $userprog) >= 0) {
73 Translations of user virtual addresses above are based on a guess at
74 the binary to use. If this guess is incorrect, then those
75 translations will be misleading.
80 if ($panic =~ /sec_no \< d-\>capacity/) {
82 \nThis assertion commonly fails when accessing a file via an inode that
83 has been closed and freed. Freeing an inode clears all its sector
84 indexes to 0xcccccccc, which is not a valid sector number for disks
85 smaller than about 1.6 TB.
92 sub check_for_keyword {
93 my ($run, $keyword, @output) = @_;
95 my ($kw_line) = grep (/$keyword/, @output);
96 return unless defined $kw_line;
98 # Most output lines are prefixed by (test-name). Eliminate this
99 # from our message for brevity.
100 $kw_line =~ s/^\([^\)]+\)\s+//;
101 print "$run: $kw_line\n";
106 sub check_for_triple_fault {
107 my ($run, @output) = @_;
109 my ($reboots) = grep (/Pintos booting/, @output) - 1;
110 return unless $reboots > 0;
113 \u$run spontaneously rebooted $reboots times.
114 This is most often caused by unhandled page faults.
120 # Get @output without header or trailer.
121 sub get_core_output {
122 my ($run, @output) = @_;
127 for my $i (0...$#_) {
128 $start = $i + 1, last
129 if ($process) = $output[$i] =~ /^Executing '(\S+).*':$/;
133 for my $i ($start...$#output) {
134 $end = $i - 1, last if $output[$i] =~ /^Execution of '.*' complete.$/;
137 fail "\u$run didn't start a thread or process\n" if !defined $start;
138 fail "\u$run started '$process' but it never finished\n" if !defined $end;
140 return @output[$start...$end];
144 my ($run) = shift @_;
145 my ($expected) = pop @_;
146 my ($output) = pop @_;
149 my (@output) = get_core_output ($run, @$output);
150 fail "\u$run didn't produce any output" if !@output;
152 if (exists $options{IGNORE_EXIT_CODES}) {
153 delete $options{IGNORE_EXIT_CODES};
154 @output = grep (!/^[a-zA-Z0-9-_]+: exit\(\d+\)$/, @output);
156 die "unknown option " . (keys (%options))[0] . "\n" if %options;
160 # Compare actual output against each allowed output.
161 if (ref ($expected) eq 'ARRAY') {
163 $expected = {map ((++$i => $_), @$expected)};
165 foreach my $key (keys %$expected) {
166 my (@expected) = split ("\n", $expected->{$key});
168 $msg .= "Acceptable output:\n";
169 $msg .= join ('', map (" $_\n", @expected));
171 # Check whether actual and expected match.
172 # If it's a perfect match, we're done.
173 if ($#output == $#expected) {
175 for (my ($i) = 0; $i <= $#expected; $i++) {
176 $eq = 0 if $output[$i] ne $expected[$i];
181 # They differ. Output a diff.
183 my ($d) = Algorithm::Diff->new (\@expected, \@output);
184 while ($d->Next ()) {
185 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
187 push (@diff, map (" $_\n", $d->Items (1)));
189 push (@diff, map ("- $_\n", $d->Items (1))) if $d->Items (1);
190 push (@diff, map ("+ $_\n", $d->Items (2))) if $d->Items (2);
194 $msg .= "Differences in `diff -u' format:\n";
195 $msg .= join ('', @diff);
198 # Failed to match. Report failure.
199 fail "Test output failed to match any acceptable form.\n\n$msg";
202 # File system extraction.
204 # check_archive (\%CONTENTS)
206 # Checks that the extracted file system's contents match \%CONTENTS.
207 # Each key in the hash is a file name. Each value may be:
209 # - $FILE: Name of a host file containing the expected contents.
211 # - [$FILE, $OFFSET, $LENGTH]: An excerpt of host file $FILE
212 # comprising the $LENGTH bytes starting at $OFFSET.
214 # - [$CONTENTS]: The literal expected file contents, as a string.
216 # - {SUBDIR}: A subdirectory, in the same form described here,
219 my ($expected_hier) = @_;
220 my (@output) = read_text_file ("$test.get-output");
221 common_checks ("file system extraction run", @output);
223 @output = get_core_output ("file system extraction run", @output);
224 @output = grep (!/^[a-zA-Z0-9-_]+: exit\(\d+\)$/, @output);
225 fail join ("\n", "Error extracting file system:", @output) if @output;
227 my ($test_base_name) = $test;
228 $test_base_name =~ s%.*/%%;
229 $expected_hier->{$test_base_name} = $test;
230 $expected_hier->{'tar'} = 'tests/filesys/extended/tar';
232 my (%expected) = normalize_fs (flatten_hierarchy ($expected_hier, ""));
233 my (%actual) = read_tar ("$test.tar");
236 foreach my $name (sort keys %expected) {
237 if (exists $actual{$name}) {
238 if (is_dir ($actual{$name}) && !is_dir ($expected{$name})) {
239 print "$name is a directory but should be an ordinary file.\n";
241 } elsif (!is_dir ($actual{$name}) && is_dir ($expected{$name})) {
242 print "$name is an ordinary file but should be a directory.\n";
246 print "$name is missing from the file system.\n";
250 foreach my $name (sort keys %actual) {
251 if (!exists $expected{$name}) {
252 if ($name =~ /^[[:print:]]+$/) {
253 print "$name exists in the file system but it should not.\n";
255 my ($esc_name) = $name;
256 $esc_name =~ s/[^[:print:]]/./g;
258 $esc_name exists in the file system but should not. (The expected name
259 of this file contains unusual characters that were printed as `.'.)
266 print "\nActual contents of file system:\n";
268 print "\nExpected contents of file system:\n";
269 print_fs (%expected);
271 foreach my $name (sort keys %expected) {
272 if (!is_dir ($expected{$name})) {
273 my ($exp_file, $exp_length) = open_file ($expected{$name});
274 my ($act_file, $act_length) = open_file ($actual{$name});
275 $errors += !compare_files ($exp_file, $exp_length,
276 $act_file, $act_length, $name,
283 fail "Extracted file system contents are not correct.\n" if $errors;
286 # open_file ([$FILE, $OFFSET, $LENGTH])
287 # open_file ([$CONTENTS])
289 # Opens a file for the contents passed in, which must be in one of
290 # the two above forms that correspond to check_archive() arguments.
292 # Returns ($HANDLE, $LENGTH), where $HANDLE is the file's handle and
293 # $LENGTH is the number of bytes in the file's content.
296 die if ref ($value) ne 'ARRAY';
298 my ($file) = tempfile ();
301 $length = length ($value->[0]);
303 syswrite ($file, $value->[0]) == $length
304 or die "writing temporary file: $!\n";
305 sysseek ($file, 0, SEEK_SET);
306 } elsif (@$value == 3) {
307 $length = $value->[2];
308 open ($file, '<', $value->[0]) or die "$value->[0]: open: $!\n";
309 die "$value->[0]: file is smaller than expected\n"
310 if -s $file < $value->[1] + $length;
311 sysseek ($file, $value->[1], SEEK_SET);
315 return ($file, $length);
318 # compare_files ($A, $A_SIZE, $B, $B_SIZE, $NAME, $VERBOSE)
320 # Compares $A_SIZE bytes in $A to $B_SIZE bytes in $B.
321 # ($A and $B are handles.)
322 # If their contents differ, prints a brief message describing
323 # the differences, using $NAME to identify the file.
324 # The message contains more detail if $VERBOSE is nonzero.
325 # Returns 1 if the contents are identical, 0 otherwise.
327 my ($a, $a_size, $b, $b_size, $name, $verbose) = @_;
331 my ($a_amt) = $a_size >= 1024 ? 1024 : $a_size;
332 my ($b_amt) = $b_size >= 1024 ? 1024 : $b_size;
333 my ($a_data, $b_data);
334 if (!defined (sysread ($a, $a_data, $a_amt))
335 || !defined (sysread ($b, $b_data, $b_amt))) {
336 die "reading $name: $!\n";
339 my ($a_len) = length $a_data;
340 my ($b_len) = length $b_data;
341 last if $a_len == 0 && $b_len == 0;
343 if ($a_data ne $b_data) {
344 my ($min_len) = $a_len < $b_len ? $a_len : $b_len;
346 for ($diff_ofs = 0; $diff_ofs < $min_len; $diff_ofs++) {
347 last if (substr ($a_data, $diff_ofs, 1)
348 ne substr ($b_data, $diff_ofs, 1));
351 printf "\nFile $name differs from expected "
352 . "starting at offset 0x%x.\n", $ofs + $diff_ofs;
354 print "Expected contents:\n";
355 hex_dump (substr ($a_data, $diff_ofs, 64), $ofs + $diff_ofs);
356 print "Actual contents:\n";
357 hex_dump (substr ($b_data, $diff_ofs, 64), $ofs + $diff_ofs);
369 # hex_dump ($DATA, $OFS)
371 # Prints $DATA in hex and text formats.
372 # The first byte of $DATA corresponds to logical offset $OFS
373 # in whatever file the data comes from.
375 my ($data, $ofs) = @_;
378 printf " (File ends at offset %08x.)\n", $ofs;
383 while ((my $size = length ($data)) > 0) {
384 my ($start) = $ofs % $per_line;
385 my ($end) = $per_line;
386 $end = $start + $size if $end - $start > $size;
387 my ($n) = $end - $start;
389 printf "0x%08x ", int ($ofs / $per_line) * $per_line;
393 for my $i ($start...$end - 1) {
394 printf "%02x", ord (substr ($data, $i - $start, 1));
395 print $i == $per_line / 2 - 1 ? '-' : ' ';
397 print " " x ($per_line - $end);
400 my ($esc_data) = substr ($data, 0, $n);
401 $esc_data =~ s/[^[:print:]]/./g;
402 print "|", " " x $start, $esc_data, " " x ($per_line - $end), "|";
406 $data = substr ($data, $n);
413 # Prints a list of files in %FS, which must be a file system
414 # as flattened by flatten_hierarchy() and normalized by
418 foreach my $name (sort keys %fs) {
419 my ($esc_name) = $name;
420 $esc_name =~ s/[^[:print:]]/./g;
422 if (!is_dir ($fs{$name})) {
423 print +file_size ($fs{$name}), "-byte file";
433 # Takes a file system as flattened by flatten_hierarchy().
434 # Returns a similar file system in which values of the form $FILE
435 # are replaced by those of the form [$FILE, $OFFSET, $LENGTH].
438 foreach my $name (keys %fs) {
439 my ($value) = $fs{$name};
440 next if is_dir ($value) || ref ($value) ne '';
441 die "can't open $value\n" if !stat $value;
442 $fs{$name} = [$value, 0, -s _];
449 # Takes a value like one in the hash returned by flatten_hierarchy()
450 # and returns 1 if it represents a directory, 0 otherwise.
453 return ref ($value) eq '' && $value eq 'directory';
458 # Takes a value like one in the hash returned by flatten_hierarchy()
459 # and returns the size of the file it represents.
462 die if is_dir ($value);
463 die if ref ($value) ne 'ARRAY';
464 return @$value > 1 ? $value->[2] : length ($value->[0]);
467 # flatten_hierarchy ($HIER_FS, $PREFIX)
469 # Takes a file system in the format expected by check_archive() and
470 # returns a "flattened" version in which file names include all parent
471 # directory names and the value of directories is just "directory".
472 sub flatten_hierarchy {
473 my (%hier_fs) = %{$_[0]};
474 my ($prefix) = $_[1];
476 for my $name (keys %hier_fs) {
477 my ($value) = $hier_fs{$name};
478 if (ref $value eq 'HASH') {
479 %flat_fs = (%flat_fs, flatten_hierarchy ($value, "$prefix$name/"));
480 $flat_fs{"$prefix$name"} = 'directory';
482 $flat_fs{"$prefix$name"} = $value;
488 # read_tar ($ARCHIVE)
490 # Reads the ustar-format tar file in $ARCHIVE
491 # and returns a flattened file system for it.
495 open (ARCHIVE, '<', $archive) or die "$archive: open: $1\n";
498 if ((my $retval = sysread (ARCHIVE, $header, 512)) != 512) {
499 die "$archive: unexpected end of file\n" if $retval >= 0;
500 die "$archive: read: $!\n";
503 last if $header eq "\0" x 512;
505 # Verify magic numbers.
506 if (substr ($header, 257, 6) ne "ustar\0"
507 || substr ($header, 263, 2) ne '00') {
508 die "$archive: corrupt ustar header\n";
512 my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8, ' ' x 8)));
513 my ($correct_chksum) = unpack ("%32a*", $header);
514 die "$archive: bad header checksum\n" if $chksum != $correct_chksum;
517 my ($name) = unpack ("Z100", $header);
518 my ($prefix) = unpack ("Z*", substr ($header, 345));
519 $name = "$prefix/$name" if $prefix ne '';
520 die "$archive: contains file with empty name" if $name eq '';
523 my ($typeflag) = substr ($header, 156, 1);
524 $typeflag = '0' if $typeflag eq "\0";
525 die "unknown file type '$typeflag'\n" if $typeflag !~ /[05]/;
528 my ($size) = oct (unpack ("Z*", substr ($header, 124, 12)));
529 die "bad size $size\n" if $size < 0;
530 $size = 0 if $typeflag eq '5';
533 if (exists $content{$name}) {
534 die "$archive: contains multiple entries for $name\n";
536 if ($typeflag eq '5') {
537 $content{$name} = 'directory';
539 my ($position) = sysseek (ARCHIVE, 0, SEEK_CUR);
540 $content{$name} = [$archive, $position, $size];
541 sysseek (ARCHIVE, int (($size + 511) / 512) * 512, SEEK_CUR);
559 my ($verdict, @messages) = @_;
561 seek ($msg_file, 0, 0);
562 push (@messages, <$msg_file>);
566 my ($result_fn) = "$test.result";
567 open (RESULT, '>', $result_fn) or die "$result_fn: create: $!\n";
568 print RESULT "$verdict\n";
569 print RESULT "$_\n" foreach @messages;
572 if ($verdict eq 'PASS') {
573 print STDOUT "pass $test\n";
575 print STDOUT "FAIL $test\n";
577 print STDOUT "$_\n" foreach @messages;
583 my ($file_name) = @_;
584 open (FILE, '<', $file_name) or die "$file_name: open: $!\n";
585 my (@content) = <FILE>;