3 use tests::Algorithm::Diff;
4 use File::Temp 'tempfile';
10 our ($test, $src_dir) = @ARGV;
12 my ($msg_file) = tempfile ();
16 my ($expected) = pop @_;
18 my (@output) = read_text_file ("$test.output");
19 common_checks (@output);
20 compare_output (@options, \@output, $expected);
26 fail "No output at all\n" if @output == 0;
28 check_for_panic (@output);
29 check_for_keyword ("FAIL", @output);
30 check_for_triple_fault (@output);
31 check_for_keyword ("TIMEOUT", @output);
33 fail "Didn't start up properly: no \"Pintos booting\" startup message\n"
34 if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
35 fail "Didn't start up properly: no \"Boot complete\" startup message\n"
36 if !grep (/Boot complete/, @output);
37 fail "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
38 if !grep (/Timer: \d+ ticks/, @output);
39 fail "Didn't shut down properly: no \"Powering off\" shutdown message\n"
40 if !grep (/Powering off/, @output);
46 my ($panic) = grep (/PANIC/, @output);
47 return unless defined $panic;
49 print "Kernel panic: ", substr ($panic, index ($panic, "PANIC")), "\n";
51 my (@stack_line) = grep (/Call stack:/, @output);
52 if (@stack_line != 0) {
53 my ($addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
55 # Find a user program to translate user virtual addresses.
58 if grep (hex ($_) < 0xc0000000, split (' ', $addrs)) > 0 && -e $test;
60 # Get and print the backtrace.
61 my ($trace) = scalar (`backtrace kernel.o $userprog $addrs`);
62 print "Call stack:$addrs\n";
63 print "Translation of call stack:\n";
67 if ($userprog ne '' && index ($trace, $userprog) >= 0) {
69 Translations of user virtual addresses above are based on a guess at
70 the binary to use. If this guess is incorrect, then those
71 translations will be misleading.
76 if ($panic =~ /sec_no \< d-\>capacity/) {
78 \nThis assertion commonly fails when accessing a file via an inode that
79 has been closed and freed. Freeing an inode clears all its sector
80 indexes to 0xcccccccc, which is not a valid sector number for disks
81 smaller than about 1.6 TB.
88 sub check_for_keyword {
89 my ($keyword, @output) = @_;
91 my ($kw_line) = grep (/$keyword/, @output);
92 return unless defined $kw_line;
94 # Most output lines are prefixed by (test-name). Eliminate this
95 # from our message for brevity.
96 $kw_line =~ s/^\([^\)]+\)\s+//;
102 sub check_for_triple_fault {
105 return unless grep (/Pintos booting/, @output) > 1;
108 Pintos spontaneously rebooted during this test.
109 This is most often caused by unhandled page faults.
115 # Get @output without header or trailer.
116 sub get_core_output {
118 do { $p = shift; } while (defined ($p) && $p !~ /^Executing '.*':$/);
119 do { $p = pop; } while (defined ($p) && $p !~ /^Execution of '.*' complete.$/);
124 my ($expected) = pop @_;
125 my ($output) = pop @_;
128 my (@output) = get_core_output (@$output);
129 fail "'$test' didn't run or didn't produce any output\n" if !@output;
131 if (exists $options{IGNORE_EXIT_CODES}) {
132 delete $options{IGNORE_EXIT_CODES};
133 @output = grep (!/^[a-zA-Z0-9-_]+: exit\(\d+\)$/, @output);
135 die "unknown option " . (keys (%options))[0] . "\n" if %options;
139 # Compare actual output against each allowed output.
140 foreach my $exp_string (@$expected) {
141 my (@expected) = split ("\n", $exp_string);
143 $msg .= "Acceptable output:\n";
144 $msg .= join ('', map (" $_\n", @expected));
146 # Check whether actual and expected match.
147 # If it's a perfect match, we're done.
148 if ($#output == $#expected) {
150 for (my ($i) = 0; $i <= $#expected; $i++) {
151 $eq = 0 if $output[$i] ne $expected[$i];
156 # They differ. Output a diff.
158 my ($d) = Algorithm::Diff->new (\@expected, \@output);
159 while ($d->Next ()) {
160 my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
162 push (@diff, map (" $_\n", $d->Items (1)));
164 push (@diff, map ("- $_\n", $d->Items (1))) if $d->Items (1);
165 push (@diff, map ("+ $_\n", $d->Items (2))) if $d->Items (2);
169 $msg .= "Differences in `diff -u' format:\n";
170 $msg .= join ('', @diff);
173 # Failed to match. Report failure.
174 fail "Test output failed to match any acceptable form.\n\n$msg";
186 my ($verdict, @rest) = @_;
189 seek ($msg_file, 0, 0);
190 while (<$msg_file>) {
195 my ($result_fn) = "$test.result";
196 open (RESULT, '>', $result_fn) or die "$result_fn: create: $!\n";
197 print RESULT "$verdict\n", $messages, @rest;
200 if ($verdict eq 'PASS') {
201 print STDOUT "pass $test\n";
203 print STDOUT "FAIL $test\n";
205 print STDOUT $messages, @rest, "\n";
211 my ($file_name) = @_;
212 open (FILE, '<', $file_name) or die "$file_name: open: $!\n";
213 my (@content) = <FILE>;