}
# Default set of tests.
-@TESTS = ("alarm-single", "alarm-multiple", "alarm-zero", "alarm-negative",
- "join-simple",
- "join-quick", "join-multiple", "join-nested",
- "join-dummy", "join-invalid", "join-no",
- "priority-preempt", "priority-fifo", "priority-donate-one",
- "priority-donate-multiple", "priority-donate-nest",
- "mlfqs-on", "mlfqs-off")
- unless @TESTS > 0;
+@TESTS = qw (args-argc args-argv0 args-argvn args-single args-multiple
+ args-dbl-space
+ sc-bad-sp sc-bad-arg sc-boundary
+ halt exit
+ create-normal create-empty create-null create-bad-ptr
+ create-long create-exists create-bound
+ open-normal open-missing open-boundary open-empty open-null
+ open-bad-ptr open-twice
+ close-normal close-twice close-stdin close-stdout close-bad-fd
+ read-normal read-bad-ptr read-boundary read-zero read-stdout
+ read-bad-fd
+ write-normal write-bad-ptr write-boundary write-zero write-stdin
+ write-bad-fd
+ exec-once exec-arg exec-multiple exec-missing exec-bad-ptr
+ join-simple join-twice join-killed join-bad-pid
+ multi-recurse multi-oom multi-child-fd
+ ) unless @TESTS > 0;
+
+our (%args);
+for my $key ('args-argc', 'args-argv0', 'args-argvn', 'args-multiple') {
+ $args{$key} = "some arguments for you!";
+}
+$args{'args-single'} = "onearg";
+$args{'args-dbl-space'} = "two args";
+$args{'multi-recurse'} = "15";
+$args{'multi-oom'} = "0";
# Handle final grade mode.
if ($grade) {
# Extract submission.
extract_tarball () if ! -d "pintos";
+# Compile submission.
+compile ();
+
# Verify that the proper directory was submitted.
-d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
$result = grade_test ($test);
$result =~ s/\n$//;
}
- print "$result\n";
+ print "$result";
+ print " - with warnings" if $result eq 'ok' && defined $details{$test};
+ print "\n";
$result{$test} = $result;
}
-# MLFQS takes results from mlfqs-on and mlfqs-off.
-grade_mlfqs_speedup ();
-grade_mlfqs_priority ();
-
# Write output.
write_grades ();
write_details ();
xsystem ("patch -fs pintos/src/lib/debug.c < $GRADES_DIR/panic.diff",
LOG => "patch",
DIE => "patch failed\n");
+ xsystem ("patch -fs pintos/src/lib/kernel/bitmap.c "
+ . "< $GRADES_DIR/random.diff",
+ LOG => "patch",
+ DIE => "patch failed\n");
+
+ open (CONSTANTS, ">pintos/src/constants.h")
+ or die "constants.h: create: $!\n";
+ print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
+ close CONSTANTS;
}
sub ext_mdyHMS {
sub test_source {
my ($test) = @_;
my ($src) = "$GRADES_DIR/$test.c";
- $src = "$GRADES_DIR/mlfqs.c" if $test =~ /^mlfqs/;
-e $src or die "$src: stat: $!\n";
return $src;
}
sub test_constants {
my ($defines) = "";
- $defines .= "#define MLFQS 1\n" if $test eq 'mlfqs-on';
return $defines;
}
return $status;
}
+sub compile {
+ print "Compiling...\n";
+ xsystem ("cd pintos/src/userprog && make", LOG => "make")
+ or return "compile error";
+}
+
sub really_run_test {
# Need to run it.
# If there's residue from an earlier test, move it to .old.
# Make output directory.
mkdir "output/$test";
-
- # Change constants.h if necessary.
- my ($defines) = test_constants ($test);
- if ($defines ne snarf ("pintos/src/constants.h")) {
- open (CONSTANTS, ">pintos/src/constants.h");
- print CONSTANTS $defines;
- close (CONSTANTS);
- }
-
- # Changes devices/timer.c if necessary.
- my ($new_time_slice) = $test eq 'priority-fifo' ? 100 : 1;
- my (@timer) = snarf ("pintos/src/devices/timer.c");
- if (!grep (/^\#define TIME_SLICE $new_time_slice$/, @timer)) {
- @timer = grep (!/^\#define TIME_SLICE/, @timer);
- unshift (@timer, "#define TIME_SLICE $new_time_slice");
- open (TIMER, ">pintos/src/devices/timer.c");
- print TIMER map ("$_\n", @timer);
- close (TIMER);
- }
-
- # Copy in the new test.c and delete enough files to ensure a full rebuild.
- my ($src) = test_source ($test);
- xsystem ("cp $src pintos/src/threads/test.c", DIE => "cp failed\n");
- unlink ("pintos/src/threads/build/threads/test.o");
- unlink ("pintos/src/threads/build/kernel.o");
- unlink ("pintos/src/threads/build/kernel.bin");
- unlink ("pintos/src/threads/build/os.dsk");
-
- # Build.
- xsystem ("cd pintos/src/threads && make", LOG => "$test/make")
- or return "compile error";
-
- # Copy out files for backtraces later.
- xsystem ("cp pintos/src/threads/build/kernel.o output/$test");
- xsystem ("cp pintos/src/threads/build/os.dsk output/$test");
+ xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk",
+ DIE => "cp failed\n");
# Run.
my ($timeout) = 10;
- $timeout = 600 if $test =~ /^mlfqs/;
- xsystem ("cd pintos/src/threads/build && pintos -v run -q",
+ $timeout = 60 if $test eq 'multi-oom';
+ my ($testargs) = defined ($args{$test}) ? " $args{$test}" : "";
+ xsystem ("pintos "
+ . "--os-disk=pintos/src/userprog/build/os.dsk "
+ . "--fs-disk=output/$test/fs.dsk "
+ . "-v run -q -ex \"$test$testargs\"",
LOG => "$test/run",
TIMEOUT => $timeout)
or return "Bochs error";
my (@output) = snarf ("output/$test/run.out");
- if (-e "$GRADES_DIR/$test.exp") {
+ my ($grade_func) = "grade_$test";
+ $grade_func =~ s/-/_/g;
+ if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
eval {
verify_common (@output);
compare_output ("$GRADES_DIR/$test.exp", @output);
}
} else {
- my ($grade_func);
- ($grade_func = $test) =~ s/-/_/g;
- eval "grade_$grade_func (\@output)";
+ eval "$grade_func (\@output)";
}
if ($@) {
die $@ if $@ =~ /at \S+ line \d+$/;
return "ok";
}
\f
-sub grade_alarm_single {
- verify_alarm (1, @_);
-}
-
-sub grade_alarm_multiple {
- verify_alarm (7, @_);
-}
-
-sub verify_alarm {
- my ($iterations, @output) = @_;
-
- verify_common (@output);
-
- my (@products);
- for (my ($i) = 0; $i < $iterations; $i++) {
- for (my ($t) = 0; $t < 5; $t++) {
- push (@products, ($i + 1) * ($t + 1) * 10);
- }
- }
- @products = sort {$a <=> $b} @products;
-
- local ($_);
- foreach (@output) {
- die $_ if /Out of order/;
-
- my ($p) = /product=(\d+)$/;
- next if !defined $p;
-
- my ($q) = shift (@products);
- die "Too many wakeups.\n" if !defined $q;
- die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
- }
- die scalar (@products) . " fewer wakeups than expected.\n"
- if @products != 0;
-}
-
-sub grade_alarm_zero {
- my (@output) = @_;
- verify_common (@output);
- die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
-}
-
-sub grade_alarm_negative {
- my (@output) = @_;
- verify_common (@output);
- die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
-}
-
-sub grade_join_invalid {
- my (@output) = @_;
- verify_common (@output);
- grep (/Testing invalid join/, @output) or die "Test didn't start\n";
- grep (/Invalid join test done/, @output) or die "Test didn't complete\n";
-}
-
-sub grade_join_no {
+sub grade_write_normal {
my (@output) = @_;
verify_common (@output);
- grep (/Testing no join/, @output) or die "Test didn't start\n";
- grep (/No join test done/, @output) or die "Test didn't complete\n";
-}
+ compare_output ("$GRADES_DIR/write-normal.exp", @output);
+ my ($test_txt) = "output/$test/test.txt";
+ get_file ("test.txt", $test_txt) if ! -e $test_txt;
-sub grade_join_multiple {
- my (@output) = @_;
+ my (@actual) = snarf ($test_txt);
+ my (@expected) = snarf ("$GRADES_DIR/sample.txt");
- verify_common (@output);
- my (@t);
- $t[4] = $t[5] = $t[6] = -1;
- local ($_);
- foreach (@output) {
- my ($idx) = /^Thread (\d+)/ or next;
- my ($iter) = /iteration (\d+)$/;
- $iter = 5 if /done!$/;
- die "Malformed output\n" if !defined $iter;
- if ($idx == 6) {
- die "Thread 6 started before either other thread finished\n"
- if $t[4] < 5 && $t[5] < 5;
- die "Thread 6 started before thread 4 finished\n"
- if $t[4] < 5;
- die "Thread 6 started before thread 5 finished\n"
- if $t[5] < 5;
+ my ($eq);
+ if ($#actual == $#expected) {
+ $eq = 1;
+ for my $i (0...$#actual) {
+ $eq = 0 if $actual[$i] ne $expected[$i];
}
- die "Thread $idx out of order output\n" if $t[$idx] != $iter - 1;
- $t[$idx] = $iter;
+ } else {
+ $eq = 0;
}
+ if (!$eq) {
+ my ($details);
+ $details = "Expected file content:\n";
+ $details .= join ('', map (" $_\n", @expected));
+ $details .= "Actual file content:\n";
+ $details .= join ('', map (" $_\n", @actual));
+ $extra{$test} = $details;
- my ($err) = "";
- for my $idx (4, 5, 6) {
- if ($t[$idx] == -1) {
- $err .= "Thread $idx did not run at all\n";
- } elsif ($t[$idx] != 5) {
- $err .= "Thread $idx only completed $t[$idx] iterations\n";
- }
+ die "File written didn't have expected content.\n";
}
- die $err if $err ne '';
}
-sub grade_priority_fifo {
+sub grade_multi_oom {
my (@output) = @_;
-
verify_common (@output);
- my ($thread_cnt) = 10;
- my ($iter_cnt) = 5;
- my (@order);
- my (@t) = (-1) x $thread_cnt;
- local ($_);
- foreach (@output) {
- my ($idx) = /^Thread (\d+)/ or next;
- my ($iter) = /iteration (\d+)$/;
- $iter = $iter_cnt if /done!$/;
- die "Malformed output\n" if !defined $iter;
- if (@order < $thread_cnt) {
- push (@order, $idx);
- die "Thread $idx repeated within first $thread_cnt iterations: "
- . join (' ', @order) . ".\n"
- if grep ($_ == $idx, @order) != 1;
- } else {
- die "Thread $idx ran when $order[0] should have.\n"
- if $idx != $order[0];
- push (@order, shift @order);
- }
- die "Thread $idx out of order output.\n" if $t[$idx] != $iter - 1;
- $t[$idx] = $iter;
- }
- my ($err) = "";
- for my $idx (0..$#t) {
- if ($t[$idx] == -1) {
- $err .= "Thread $idx did not run at all.\n";
- } elsif ($t[$idx] != $iter_cnt) {
- $err .= "Thread $idx only completed $t[$idx] iterations.\n";
- }
+ @output = fix_exit_codes (get_core_output (@output));
+ my ($n) = 0;
+ while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) {
+ die "Child process $m started out of order.\n" if $m != $n;
+ $n = $m + 1;
+ shift @output;
+ }
+ die "Only $n child processes started.\n" if $n < 15;
+
+ # There could be a death notice for a process that didn't get
+ # fully loaded, and/or notices from the loader.
+ while (@output > 0
+ && ($output[0] =~ /^\(multi-oom\) end $n$/
+ || $output[0] =~ /^load: /)) {
+ shift @output;
}
- die $err if $err ne '';
-}
-
-sub grade_mlfqs_on {
- my (@output) = @_;
- verify_common (@output);
- our (@mlfqs_on_stats) = mlfqs_stats (@output);
-}
-sub grade_mlfqs_off {
- my (@output) = @_;
- verify_common (@output);
- our (@mlfqs_off_stats) = mlfqs_stats (@output);
-}
+ while (--$n >= 0) {
+ die "Output ended unexpectedly before process $n finished.\n"
+ if @output < 2;
-sub grade_mlfqs_speedup {
- our (@mlfqs_off_stats);
- our (@mlfqs_on_stats);
- eval {
- check_mlfqs ();
- my ($off_ticks) = $mlfqs_off_stats[1];
- my ($on_ticks) = $mlfqs_on_stats[1];
- die "$off_ticks ticks without MLFQS, $on_ticks with MLFQS\n"
- if $on_ticks >= $off_ticks;
- die "ok\n";
- };
- chomp $@;
- $result{'mlfqs-speedup'} = $@;
-}
+ local ($_);
+ chomp ($_ = shift @output);
+ die "Found '$_' expecting 'end' message.\n" if !/^\(multi-oom\) end/;
+ die "Child process $n ended out of order.\n"
+ if !/^\(multi-oom\) end $n$/;
-sub grade_mlfqs_priority {
- our (@mlfqs_off_stats);
- our (@mlfqs_on_stats);
- eval {
- check_mlfqs () if !defined (@mlfqs_on_stats);
- for my $cat qw (CPU IO MIX) {
- die "Priority changed away from PRI_DEFAULT (29) without MLFQS\n"
- if $mlfqs_off_stats[0]{$cat}{MIN} != 29
- || $mlfqs_off_stats[0]{$cat}{MAX} != 29;
- die "Minimum priority never changed from PRI_DEFAULT (29) "
- . "with MLFQS\n"
- if $mlfqs_on_stats[0]{$cat}{MIN} == 29;
- die "Maximum priority never changed from PRI_DEFAULT (29) "
- . "with MLFQS\n"
- if $mlfqs_on_stats[0]{$cat}{MAX} == 29;
- }
- die "ok\n";
- };
- chomp $@;
- $result{'mlfqs-priority'} = $@;
+ chomp ($_ = shift @output);
+ die "Kernel didn't print proper exit message for process $n.\n"
+ if !/^multi-oom: exit\($n\)$/;
+ }
+ die "Spurious output at end: '$output[0]'.\n" if @output;
}
-sub check_mlfqs {
- our (@mlfqs_off_stats);
- our (@mlfqs_on_stats);
- die "p1-4 didn't finish with MLFQS on or off\n"
- if !defined (@mlfqs_off_stats) && !defined (@mlfqs_on_stats);
- die "p1-4 didn't finish with MLFQS on\n"
- if !defined (@mlfqs_on_stats);
- die "p1-4 didn't finish with MLFQS off\n"
- if !defined (@mlfqs_off_stats);
+sub get_file {
+ my ($guest_fn, $host_fn) = @_;
+ xsystem ("pintos "
+ . "--os-disk=pintos/src/userprog/build/os.dsk "
+ . "--fs-disk=output/$test/fs.dsk "
+ . "-v get $guest_fn $host_fn",
+ LOG => "$test/get-$guest_fn",
+ TIMEOUT => 10)
+ or die "get $guest_fn failed\n";
}
-sub mlfqs_stats {
- my (@output) = @_;
- my (%stats) = (CPU => {}, IO => {}, MIX => {});
- my (%map) = ("CPU intensive" => 'CPU',
- "IO intensive" => 'IO',
- "Alternating IO/CPU" => 'MIX');
- my (%rmap) = reverse %map;
- my ($ticks);
- local ($_);
- foreach (@output) {
- $ticks = $1 if /Timer: (\d+) ticks/;
- my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
- my ($t) = $map{$thread} or next;
-
- my ($s) = $stats{$t};
- $$s{N}++;
- $$s{SUM} += $pri;
- $$s{SUM2} += $pri * $pri;
- $$s{MIN} = $pri if !defined ($$s{MIN}) || $pri < $$s{MIN};
- $$s{MAX} = $pri if !defined ($$s{MAX}) || $pri > $$s{MAX};
- }
-
- my (%expect_n) = (CPU => 5000, IO => 1000, MIX => 12000);
- for my $cat (values (%map)) {
- my ($s) = $stats{$cat};
- die "$rmap{$cat} printed $$s{N} times, not $expect_n{$cat}\n"
- if $$s{N} != $expect_n{$cat};
- die "$rmap{$cat} priority dropped to $$s{MIN}, below PRI_MIN (0)\n"
- if $$s{MIN} < 0;
- die "$rmap{$cat} priority rose to $$s{MAX}, above PRI_MAX (59)\n"
- if $$s{MAX} > 59;
- $$s{MEAN} = $$s{SUM} / $$s{N};
- }
-
- return (\%stats, $ticks);
-}
\f
sub verify_common {
my (@output) = @_;
} else {
$A2L = "i386-elf-addr2line";
}
- open (A2L, "$A2L -fe output/$test/kernel.o @addrs|");
+ open (A2L, "$A2L -fe pintos/src/userprog/build/kernel.o @addrs|");
for (;;) {
my ($function, $line);
last unless defined ($function = <A2L>);
if !grep (/Powering off/, @output);
}
-sub compare_output {
- my ($exp_file, @actual) = @_;
- my (@expected) = snarf ($exp_file);
-
- @actual = map ("$_\n", @actual);
- @expected = map ("$_\n", @expected);
+# Get @output without header or trailer.
+sub get_core_output {
+ my (@output) = @_;
- # Trim header and trailer from @actual.
- while (scalar (@actual) && $actual[0] ne $expected[0]) {
- shift (@actual);
+ our ($test);
+ my ($first);
+ for ($first = 0; $first <= $#output; $first++) {
+ $first++, last if $output[$first] =~ /^Executing '$test.*':$/;
}
- die "First line of expected output was not present.\n" if !@actual;
- while (scalar (@actual) && $actual[$#actual] ne $expected[$#expected]) {
- pop (@actual);
+
+ my ($last);
+ for ($last = $#output; $last >= 0; $last--) {
+ $last--, last if $output[$last] =~ /^Timer: \d+ ticks$/;
}
- die "Final line of expected output was not present.\n" if !@actual;
-
- # Check whether they're the same.
- if ($#actual == $#expected) {
- my ($eq) = 1;
- for (my ($i) = 0; $i <= $#expected; $i++) {
- $eq = 0 if $actual[$i] ne $expected[$i];
- }
- return if $eq;
+
+ if ($last < $first) {
+ my ($no_first) = $first > $#output;
+ my ($no_last) = $last < $#output;
+ die "Couldn't locate output.\n";
}
- # They differ. Output a diff.
- my (@diff) = "";
- my ($d) = Algorithm::Diff->new (\@expected, \@actual);
- while ($d->Next ()) {
- my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
- if ($d->Same ()) {
- push (@diff, map (" $_", $d->Items (1)));
- } else {
- push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
- push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
+ return @output[$first ... $last];
+}
+
+sub fix_exit_codes {
+ my (@output) = @_;
+
+ # Fix up lines that look like exit codes.
+ # Exit codes are supposed to be printed in the form "process: exit(code)"
+ # but people get unfortunately creative with it.
+ for my $i (0...$#output) {
+ local ($_) = $output[$i];
+
+ my ($process, $code);
+ if ((($process, $code) = /^([-a-zA-Z0-9 ]+):.*[ \(](-?\d+)\b\)?$/)
+ || (($process, $code) = /^([-a-zA-Z0-9 ]+) exit\((-?\d+)\)$/)
+ || (($process, $code)
+ = /^([-a-zA-Z0-9 ]+) \(.*\): exit\((-?\d+)\)$/)
+ || (($process, $code) = /^([-a-zA-Z0-9 ]+):\( (-?\d+) \) $/)
+) {
+ $process = substr ($process, 0, 15);
+ $process =~ s/\s.*//;
+ $output[$i] = "$process: exit($code)\n";
}
}
+ return @output;
+}
+
+sub compare_output {
+ my ($exp, @actual) = @_;
+ @actual = fix_exit_codes (get_core_output (map ("$_\n", @actual)));
+
my ($details) = "";
$details .= "$test actual output:\n";
$details .= join ('', map (" $_", @actual));
- $details .= "\n$test expected output:\n";
- $details .= join ('', map (" $_", @expected));
- $details .= "\nOutput differences in `diff -u' format:\n";
- $details .= join ('', @diff) . "\n";
+
+ my (@exp) = map ("$_\n", snarf ($exp));
+
+ my ($fuzzy_match) = 0;
+ while (@exp != 0) {
+ my (@expected);
+ while (@exp != 0) {
+ my ($s) = shift (@exp);
+ last if $s eq "--OR--\n";
+ push (@expected, $s);
+ }
+
+ $details .= "\n$test acceptable output:\n";
+ $details .= join ('', map (" $_", @expected));
+
+ # Check whether they're the same.
+ if ($#actual == $#expected) {
+ my ($eq) = 1;
+ for (my ($i) = 0; $i <= $#expected; $i++) {
+ $eq = 0 if $actual[$i] ne $expected[$i];
+ }
+ return if $eq;
+ }
+
+ # They differ. Output a diff.
+ my (@diff) = "";
+ my ($d) = Algorithm::Diff->new (\@expected, \@actual);
+ my ($not_fuzzy_match) = 0;
+ while ($d->Next ()) {
+ my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
+ if ($d->Same ()) {
+ push (@diff, map (" $_", $d->Items (1)));
+ } else {
+ push (@diff, map ("- $_", $d->Items (1))) if $d->Items (1);
+ push (@diff, map ("+ $_", $d->Items (2))) if $d->Items (2);
+ if ($d->Items (1)
+ || grep (/\($test\)|exit\(-?\d+\)/, $d->Items (2))) {
+ $not_fuzzy_match = 1;
+ }
+ }
+ }
+ $fuzzy_match = 1 if !$not_fuzzy_match;
+
+ $details .= "Differences in `diff -u' format:\n";
+ $details .= join ('', @diff);
+ $details .= "(This is considered a `fuzzy match'.)\n"
+ if !$not_fuzzy_match;
+ }
+
$details{$test} = $details;
- die "Output differs from expected. Details at end of file.\n";
+ die "Output differs from expected. Details at end of file.\n"
+ unless $fuzzy_match;
}
\f
sub write_grades {
open (DETAILS, ">details.out");
my ($n) = 0;
for my $test (@TESTS) {
- next if $result{$test} eq 'ok';
+ next if $result{$test} eq 'ok' && !defined $details{$test};
my ($details) = $details{$test};
next if !defined ($details) && ! -e "output/$test/run.out";
unlink ("output/$log.err") if defined ($log) && $status == 0;
+ die $options{DIE} if $status != 0 && defined $options{DIE};
+
return $status == 0;
}
projects / pintos-anon / blobdiff