7 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
8 -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
10 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
14 = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
16 die "no pintos dir and no source tarball\n" if scalar (@tarballs) == 0;
17 die "no pintos dir and multiple tarballs\n" if scalar (@tarballs) > 1;
18 mkdir "pintos" or die "pintos: mkdir: $!\n";
19 mkdir "pintos/src" or die "pintos: mkdir: $!\n";
20 print "Extracting $tarballs[0]...\n";
21 xsystem ("", "cd pintos/src && tar xzf ../../$tarballs[0]")
22 or die "extraction failed\n";
24 -d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
26 print "Compiling initial tree...\n";
27 xsystem ("make", "cd pintos/src/threads && make") or die;
29 for my $test ("alarm-single", "alarm-multiple", "alarm-zero", "alarm-negative",
31 #"join-quick", "join-multiple", "join-nested",
32 #"join-dummy", "join-invalid", "join-no",
33 #"priority-preempt", "priority-fifo", "priority-donate-one",
34 #"priority-donate-multiple", "priority-donate-nest",
37 print "Testing $test: ";
38 my ($result) = run_test ($test);
41 if ($result eq 'ok') {
42 print "Grading $test: ";
43 $result = grade_test ($test);
51 my (@output) = snarf ("output/$test.run.out");
53 ($grade_func = $test) =~ s/-/_/g;
54 eval "grade_$grade_func(\@output)";
56 die $@ if $@ =~ /at \S+ line \d+$/;
62 sub grade_alarm_single {
66 sub grade_alarm_multiple {
70 sub grade_alarm_zero {
72 #verify_common (@output);
73 die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
76 sub grade_alarm_negative {
78 #verify_common (@output);
79 die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
82 sub grade_join_simple {
84 #verify_common (@output);
85 compare_output ("$GRADES_DIR/join-simple.exp", @output);
89 my ($exp_file, @actual) = @_;
90 my (@expected) = snarf ($exp_file);
92 # Trim header and trailer from @actual.
93 while (scalar (@actual) && $actual[0] ne $expected[0]) {
96 die "First line of expected output was not present.\n" if !@actual;
97 while (scalar (@actual) && $actual[$#actual] ne $expected[$#expected]) {
100 die "Final line of expected output was not present.\n" if !@actual;
102 # Check whether they're the same.
103 if ($#actual == $#expected) {
105 for (my ($i) = 0; $i <= $#expected; $i++) {
106 $eq = 0 if $actual[$i] ne $expected[$i];
111 # They differ. Output a diff.
112 my (@diff) = split ("\n", diff (\@expected, \@actual, {CONTEXT => 0}));
113 for (my ($i) = 0; $i < $#diff; ) {
114 if ($diff[$i] =~ /^@@/) {
124 my ($diff) = join ("\n", @diff);
125 die "Output differs from expected:\n$diff\n";
129 my ($iterations, @output) = @_;
131 #verify_common (@output);
134 for (my ($i) = 0; $i < $iterations; $i++) {
135 for (my ($t) = 0; $t < 5; $t++) {
136 push (@products, ($i + 1) * ($t + 1) * 10);
139 @products = sort {$a <=> $b} @products;
142 die $_ if /Out of order/;
144 my ($p) = /product=(\d+)$/;
147 my ($q) = shift (@products);
148 die "Too many wakeups.\n" if !defined $q;
149 die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
151 die scalar (@products) . " fewer wakeups than expected.\n"
157 return "ok" if -f "output/$test.run.out";
159 my ($src) = "$GRADES_DIR/$test.c";
160 -e $src or die "$src: stat: $!\n";
161 xsystem ("", "cp $src pintos/src/threads/test.c") or die;
162 unlink ("pintos/src/threads/build/threads/test.o");
163 unlink ("pintos/src/threads/build/kernel.o");
164 unlink ("pintos/src/threads/build/kernel.bin");
165 unlink ("pintos/src/threads/build/os.dsk");
166 xsystem ("$test.make", "cd pintos/src/threads && make")
167 or return "compile error";
168 xsystem ("$test.run", "cd pintos/src/threads/build && pintos -v run -q")
169 or return "Bochs error";
174 my ($log, $command) = @_;
175 print "$command\n" if $verbose;
179 $status = systimeout ("($command) >output/$log.out 2>output/$log.err");
180 unlink ("output/$log.err") unless $status != 0;
182 $status = systimeout ($command);
186 if WIFSIGNALED ($status) && WTERMSIG ($status) == SIGINT;
195 local $SIG{ALRM} = sub { die "alarm\n" };
197 $status = system ($command);
201 die unless $@ eq "alarm\n"; # propagate unexpected errors
202 print "Timed out.\n";
210 open (OUTPUT, $file) or die "$file: open: $!\n";
211 my (@lines) = <OUTPUT>;