-
-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;
-
- for $_ (@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 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;
- }
-
-sub run_test {
- my ($test) = @_;
- return "ok" if -f "output/$test.run.out";
-
- my ($defines) = test_constants ($test);
- if ($defines ne snarf ("pintos/src/constants.h")) {
- open (CONSTANTS, ">pintos/src/constants.h");
- print CONSTANTS $defines;
- close (CONSTANTS);
- }
-
- $src = test_source ($test);
- xsystem ("", "cp $src pintos/src/threads/test.c") or die;
- 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");
- xsystem ("$test.make", "cd pintos/src/threads && make")
- or return "compile error";
-
- my ($timeout) = 10;
- $timeout = 600 if $test =~ /^mlfqs/;
- xsystem ("$test.run", "cd pintos/src/threads/build && pintos -v run -q",
- $timeout)
- or return "Bochs error";
- return "ok";
-}
-
-sub xsystem {
- my ($log, $command, $timeout) = @_;
- print "$command\n" if $verbose;
-
- $timeout = 0 if !defined $timeout;
-
- my ($status);
- if ($log ne '') {
- $status = systimeout ("($command) >output/$log.out 2>output/$log.err",
- $timeout);
- unlink ("output/$log.err") unless $status != 0;
- } else {
- $status = systimeout ($command, $timeout);
- }
-
- die "Interrupted\n"
- if WIFSIGNALED ($status) && WTERMSIG ($status) == SIGINT;
-
- return $status == 0;
-}
-
-sub systimeout {
- my ($command, $timeout) = @_;
- my ($pid, $status);
- eval {
- local $SIG{ALRM} = sub { die "alarm\n" };
- alarm $timeout;
- $pid = fork;
- die "fork: $!\n" if !defined $pid;
- exec ($command), die "$command: exec: $!\n" if !$pid;
- waitpid ($pid, 0);
- $status = $?;
- alarm 0;
- };
- if ($@) {
- die unless $@ eq "alarm\n"; # propagate unexpected errors
- print "Timed out.\n";
- kill SIGTERM, $pid;
- $status = 0;
- }
- return $status;
-}
-
-sub snarf {
- my ($file) = @_;
- open (OUTPUT, $file) or die "$file: open: $!\n";
- my (@lines) = <OUTPUT>;
- chomp (@lines);
- close (OUTPUT);
- return wantarray ? @lines : join ('', map ("$_\n", @lines));
-}
-
-sub make_summary {
- @summary = snarf ("$GRADES_DIR/tests.txt");