pintos-os.org Git - pintos-anon/blob - grading/threads/run-tests

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use POSIX;
   6 use Algorithm::Diff;
   7 use Getopt::Long;
   8
   9 our ($VERBOSE) = 0;     # Verbosity of output
  10 our (@TESTS);           # Tests to run.
  11 my ($clean) = 0;
  12
  13 GetOptions ("v|verbose+" => \$VERBOSE,
  14             "h|help" => sub { usage (0) },
  15             "t|test=s" => \@TESTS,
  16             "c|clean" => \$clean)
  17     or die "Malformed command line; use --help for help.\n";
  18 die "Non-option argument not supported; use --help for help.\n"
  19     if @ARGV > 0;
  20
  21 sub usage {
  22     my ($exitcode) = @_;
  23     print "run-tests, for grading Pintos thread projects.\n\n";
  24     print "Invoke from a directory containing a student tarball named by\n";
  25     print "the submit script, e.g. username.Oct.12.04.20.04.09.tar.gz.\n";
  26     print "In normal usage, no options are needed.\n\n";
  27     print "Output is produced in tests.out and details.out.\n\n";
  28     print "Options:\n";
  29     print "  -c, --clean     Remove old output files before starting\n";
  30     print "  -t, --test=TEST Execute TEST only (allowed multiple times)\n";
  31     print "  -v, --verbose   Print commands before executing them\n";
  32     print "  -h, --help      Print this help message\n";
  33     exit $exitcode;
  34 }
  35
  36 # Default set of tests.
  37 @TESTS = ("alarm-single", "alarm-multiple", "alarm-zero", "alarm-negative",
  38           "join-simple",
  39           "join-quick", "join-multiple", "join-nested",
  40           "join-dummy", "join-invalid", "join-no",
  41           "priority-preempt", "priority-fifo", "priority-donate-one",
  42           "priority-donate-multiple", "priority-donate-nest",
  43           "mlfqs-on", "mlfqs-off")
  44     unless @TESTS > 0;
  45
  46 # Find the directory that contains the grading files.
  47 our ($GRADES_DIR);
  48 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
  49 -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
  50
  51 if ($clean) {
  52     # Verify that we're roughly in the correct directory
  53     # before we go blasting away files.
  54     choose_tarball ();
  55
  56     xsystem ("rm -rf output pintos", VERBOSE => 1);
  57     xsystem ("rm -f details.out tests.out", VERBOSE => 1);
  58 }
  59
  60 # Create output directory, if it doesn't already exist.
  61 -d ("output") || mkdir ("output") or die "output: mkdir: $!\n";
  62
  63 # Extract submission.
  64 extract_tarball () if ! -d "pintos";
  65
  66 # Verify that the proper directory was submitted.
  67 -d "pintos/src/threads" or die "pintos/src/threads: stat: $!\n";
  68
  69 # Run and grade the tests.
  70 our $test;
  71 our %result;
  72 our %details;
  73 our %extra;
  74 for $test (@TESTS) {
  75     my ($result);
  76     do {
  77         print "$test: ";
  78         $result = run_test ($test);
  79         if ($result eq 'ok') {
  80             $result = grade_test ($test);
  81             $result =~ s/\n$//;
  82         }
  83         print "$result\n";
  84     } while ($result eq 'rerun');
  85
  86     $result{$test} = $result;
  87 }
  88
  89 # Write output.
  90 write_grades ();
  91 write_details ();
  92 \f
  93 sub choose_tarball {
  94     my (@tarballs)
  95         = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
  96                 glob ("*.tar.gz"));
  97     die "no pintos dir and no source tarball\n" if scalar (@tarballs) == 0;
  98
  99     # Sort tarballs in reverse order by time.
 100     @tarballs = sort { ext_mdyHMS ($b) cmp ext_mdyHMS ($a) } @tarballs;
 101
 102     print "Multiple tarballs: choosing $tarballs[0]\n"
 103         if scalar (@tarballs) > 1;
 104     return $tarballs[0];
 105 }
 106
 107 sub extract_tarball {
 108     my ($tarball) = choose_tarball ();
 109
 110     mkdir "pintos" or die "pintos: mkdir: $!\n";
 111     mkdir "pintos/src" or die "pintos: mkdir: $!\n";
 112
 113     print "Extracting $tarball...\n";
 114     xsystem ("cd pintos/src && tar xzf ../../$tarball",
 115              DIE => "extraction failed\n");
 116
 117     print "Patching...\n";
 118     xsystem ("patch -fs pintos/src/lib/debug.c < $GRADES_DIR/panic.diff",
 119              LOG => "patch",
 120              DIE => "patch failed\n");
 121 }
 122
 123 sub ext_mdyHMS {
 124     my ($s) = @_;
 125     my ($ms, $d, $y, $H, $M, $S) =
 126         $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
 127         or die;
 128     my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
 129         or die;
 130     return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
 131 }
 132 \f
 133 sub test_source {
 134     my ($test) = @_;
 135     my ($src) = "$GRADES_DIR/$test.c";
 136     $src = "$GRADES_DIR/mlfqs.c" if $test =~ /^mlfqs/;
 137     -e $src or die "$src: stat: $!\n";
 138     return $src;
 139 }
 140
 141 sub test_constants {
 142    my ($defines) = "";
 143    $defines .= "#define MLFQS 1\n" if $test eq 'mlfqs-on';
 144    return $defines;
 145  }
 146
 147 sub run_test {
 148     my ($test) = @_;
 149     return "ok" if -f "output/$test.run.out";
 150
 151     my ($defines) = test_constants ($test);
 152     if ($defines ne snarf ("pintos/src/constants.h")) {
 153         open (CONSTANTS, ">pintos/src/constants.h");
 154         print CONSTANTS $defines;
 155         close (CONSTANTS);
 156     }
 157
 158     my ($src) = test_source ($test);
 159     xsystem ("cp $src pintos/src/threads/test.c", DIE => "cp failed\n");
 160     unlink ("pintos/src/threads/build/threads/test.o");
 161     unlink ("pintos/src/threads/build/kernel.o");
 162     unlink ("pintos/src/threads/build/kernel.bin");
 163     unlink ("pintos/src/threads/build/os.dsk");
 164     xsystem ("cd pintos/src/threads && make", LOG => "$test.make")
 165         or return "compile error";
 166
 167     my ($timeout) = 10;
 168     $timeout = 600 if $test =~ /^mlfqs/;
 169     xsystem ("cd pintos/src/threads/build && pintos -v run -q",
 170              LOG => "$test.run",
 171              TIMEOUT => $timeout)
 172         or return "Bochs error";
 173     return "ok";
 174 }
 175
 176 sub grade_test {
 177     my ($test) = @_;
 178
 179     my (@output) = snarf ("output/$test.run.out");
 180
 181     if (-e "$GRADES_DIR/$test.exp") {
 182         eval {
 183             verify_common (@output);
 184             compare_output ("$GRADES_DIR/$test.exp", @output);
 185         }
 186     } else {
 187         my ($grade_func);
 188         ($grade_func = $test) =~ s/-/_/g;
 189         eval "grade_$grade_func (\@output)";
 190     }
 191     if ($@) {
 192         die $@ if $@ =~ /at \S+ line \d+$/;
 193         return $@;
 194     }
 195     return "ok";
 196 }
 197 \f
 198 sub grade_alarm_single {
 199     verify_alarm (1, @_);
 200 }
 201
 202 sub grade_alarm_multiple {
 203     verify_alarm (7, @_);
 204 }
 205
 206 sub verify_alarm {
 207     my ($iterations, @output) = @_;
 208
 209     verify_common (@output);
 210
 211     my (@products);
 212     for (my ($i) = 0; $i < $iterations; $i++) {
 213         for (my ($t) = 0; $t < 5; $t++) {
 214             push (@products, ($i + 1) * ($t + 1) * 10);
 215         }
 216     }
 217     @products = sort {$a <=> $b} @products;
 218
 219     local ($_);
 220     foreach (@output) {
 221         die $_ if /Out of order/;
 222
 223         my ($p) = /product=(\d+)$/;
 224         next if !defined $p;
 225
 226         my ($q) = shift (@products);
 227         die "Too many wakeups.\n" if !defined $q;
 228         die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
 229     }
 230     die scalar (@products) . " fewer wakeups than expected.\n"
 231         if @products != 0;
 232 }
 233
 234 sub grade_alarm_zero {
 235     my (@output) = @_;
 236     verify_common (@output);
 237     die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
 238 }
 239
 240 sub grade_alarm_negative {
 241     my (@output) = @_;
 242     verify_common (@output);
 243     die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
 244 }
 245
 246 sub grade_join_invalid {
 247     my (@output) = @_;
 248     verify_common (@output);
 249     grep (/Testing invalid join/, @output) or die "Test didn't start\n";
 250     grep (/Invalid join test done/, @output) or die "Test didn't complete\n";
 251 }
 252
 253 sub grade_join_no {
 254     my (@output) = @_;
 255     verify_common (@output);
 256     grep (/Testing no join/, @output) or die "Test didn't start\n";
 257     grep (/No join test done/, @output) or die "Test didn't complete\n";
 258 }
 259
 260 sub grade_join_multiple {
 261     my (@output) = @_;
 262
 263     verify_common (@output);
 264     my (@t);
 265     $t[4] = $t[5] = $t[6] = -1;
 266     local ($_);
 267     foreach (@output) {
 268         my ($idx) = /^Thread (\d+)/ or next;
 269         my ($iter) = /iteration (\d+)$/;
 270         $iter = 5 if /done!$/;
 271         die "Malformed output\n" if !defined $iter;
 272         if ($idx == 6) {
 273             die "Thread 6 started before either other thread finished\n"
 274                 if $t[4] < 5 && $t[5] < 5;
 275             die "Thread 6 started before thread 4 finished\n"
 276                 if $t[4] < 5;
 277             die "Thread 6 started before thread 5 finished\n"
 278                 if $t[5] < 5;
 279         }
 280         die "Thread $idx out of order output\n" if $t[$idx] != $iter - 1;
 281         $t[$idx] = $iter;
 282     }
 283
 284     my ($err) = "";
 285     for my $idx (4, 5, 6) {
 286         if ($t[$idx] == -1) {
 287             $err .= "Thread $idx did not run at all\n";
 288         } elsif ($t[$idx] != 5) {
 289             $err .= "Thread $idx only completed $t[$idx] iterations\n";
 290         }
 291     }
 292     die $err if $err ne '';
 293 }
 294
 295 sub grade_priority_fifo {
 296     my (@output) = @_;
 297
 298     verify_common (@output);
 299     my ($thread_cnt) = 10;
 300     my ($iter_cnt) = 5;
 301     my (@order);
 302     my (@t) = (-1) x $thread_cnt;
 303     local ($_);
 304     foreach (@output) {
 305         my ($idx) = /^Thread (\d+)/ or next;
 306         my ($iter) = /iteration (\d+)$/;
 307         $iter = $iter_cnt if /done!$/;
 308         die "Malformed output\n" if !defined $iter;
 309         if (@order < $thread_cnt) {
 310             push (@order, $idx);
 311             die "Thread $idx repeated within first $thread_cnt iterations: "
 312                 . join (' ', @order) . ".\n"
 313                 if grep ($_ == $idx, @order) != 1;
 314         } else {
 315             die "Thread $idx ran when $order[0] should have.\n"
 316                 if $idx != $order[0];
 317             push (@order, shift @order);
 318         }
 319         die "Thread $idx out of order output.\n" if $t[$idx] != $iter - 1;
 320         $t[$idx] = $iter;
 321     }
 322
 323     my ($err) = "";
 324     for my $idx (0..$#t) {
 325         if ($t[$idx] == -1) {
 326             $err .= "Thread $idx did not run at all.\n";
 327         } elsif ($t[$idx] != $iter_cnt) {
 328             $err .= "Thread $idx only completed $t[$idx] iterations.\n";
 329         }
 330     }
 331     die $err if $err ne '';
 332 }
 333
 334 sub grade_mlfqs_on {
 335     my (@output) = @_;
 336     verify_common (@output);
 337     mlfqs_stats (@output);
 338 }
 339
 340 sub grade_mlfqs_off {
 341     my (@output) = @_;
 342     verify_common (@output);
 343     mlfqs_stats (@output);
 344 }
 345
 346 sub mlfqs_stats {
 347     my (@output) = @_;
 348     my (%stats) = ("io" => {}, "cpu" => {}, "mix" => {});
 349     my (%map) = ("CPU intensive" => "cpu",
 350                  "IO intensive" => "io",
 351                  "Alternating IO/CPU" => "mix");
 352     local ($_);
 353     foreach (@output) {
 354         my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
 355         my ($t) = $map{$thread} or next;
 356
 357         my ($s) = $stats{$t};
 358         $$s{"n"}++;
 359         $$s{"sum"} += $pri;
 360         $$s{"sum2"} += $pri * $pri;
 361         $$s{"min"} = $pri if !defined ($$s{"min"}) || $pri < $$s{"min"};
 362         $$s{"max"} = $pri if !defined ($$s{"max"}) || $pri > $$s{"max"};
 363     }
 364
 365     my ($details) = "";
 366     for my $t (keys %stats) {
 367         my ($s) = $stats{$t};
 368         $details .= "$t: n=$$s{'n'}, min=$$s{'min'}, max=$$s{'max'}, avg=" . int ($$s{'sum'} / $$s{'n'}) . "\n";
 369     }
 370     $details{$test} = $details;
 371     die "MLFQS\n";
 372 }
 373 \f
 374 sub verify_common {
 375     my (@output) = @_;
 376
 377     my (@assertion) = grep (/PANIC/, @output);
 378     if (@assertion != 0) {
 379         my ($details) = "Kernel panic:\n  $assertion[0]\n";
 380
 381         my (@stack_line) = grep (/Call stack:/, @output);
 382         if (@stack_line != 0) {
 383             get_binaries ();
 384             $details .= "  $stack_line[0]\n\n";
 385             $details .= "Translation of backtrace:\n";
 386             my ($addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
 387
 388             my ($A2L);
 389             if (`uname -m`
 390                 =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
 391                 $A2L = "addr2line";
 392             } else {
 393                 $A2L = "i386-elf-addr2line";
 394             }
 395             open (A2L, "$A2L -fe pintos/src/threads/build/kernel.o $addrs|");
 396             while (my $function = <A2L>) {
 397                 my ($line) = <A2L>;
 398                 chomp $function;
 399                 chomp $line;
 400                 $details .= "  $function ($line)\n";
 401             }
 402         }
 403         $extra{$test} = $details;
 404         die "Kernel panic.  Details at end of file.\n"
 405     }
 406
 407     die "No output at all\n" if @output == 0;
 408     die "Didn't start up properly: no \"Pintos booting\" startup message\n"
 409         if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
 410     die "Didn't start up properly: no \"Boot complete\" startup message\n"
 411         if !grep (/Boot complete/, @output);
 412     die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
 413         if !grep (/Timer: \d+ ticks/, @output);
 414     die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
 415         if !grep (/Powering off/, @output);
 416 }
 417
 418 sub get_binaries {
 419     if (!files_equal ("pintos/src/threads/test.c", test_source ($test))
 420         || !file_contains ("pintos/src/constants.h",
 421                            test_constants ($test))) {
 422         unlink ("output/$test.run.out")
 423             or die "output/$test.run.out: unlink: $!\n";
 424         die "rerun\n";
 425     }
 426 }
 427
 428 sub compare_output {
 429     my ($exp_file, @actual) = @_;
 430     my (@expected) = snarf ($exp_file);
 431
 432     @actual = map ("$_\n", @actual);
 433     @expected = map ("$_\n", @expected);
 434
 435     # Trim header and trailer from @actual.
 436     while (scalar (@actual) && $actual[0] ne $expected[0]) {
 437         shift (@actual);
 438     }
 439     die "First line of expected output was not present.\n" if !@actual;
 440     while (scalar (@actual) && $actual[$#actual] ne $expected[$#expected]) {
 441         pop (@actual);
 442     }
 443     die "Final line of expected output was not present.\n" if !@actual;
 444
 445     # Check whether they're the same.
 446     if ($#actual == $#expected) {
 447         my ($eq) = 1;
 448         for (my ($i) = 0; $i <= $#expected; $i++) {
 449             $eq = 0 if $actual[$i] ne $expected[$i];
 450         }
 451         return if $eq;
 452     }
 453
 454     # They differ.  Output a diff.
 455     my ($diff) = "";
 456     my ($d) = Algorithm::Diff->new (\@expected, \@actual);
 457     $d->Base (1);
 458     while ($d->Next ()) {
 459         my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
 460         if ($d->Same ()) {
 461             if ($af != $al) {
 462                 $diff .= "Actual lines $af...$al match expected lines "
 463                     . "$ef...$el.\n";
 464             } else {
 465                 $diff .= "Actual line $af matches expected line $ef.\n";
 466             }
 467         } else {
 468             my (@i1) = $d->Items (1);
 469             my (@i2) = $d->Items (2);
 470             if (!@i1) {
 471                 $diff .= "Extra or misplaced line(s) $af...$al "
 472                     . "in actual output:\n";
 473                 $diff .= number_lines ($af, \@i2);
 474             } elsif (!$d->Items (2)) {
 475                 $diff .= "Expected line(s) $ef...$el missing or misplaced:\n";
 476                 $diff .= number_lines ($ef, \@i1);
 477             } else {
 478                 $diff .= "The following expected line(s) $ef...$el:\n";
 479                 $diff .= number_lines ($ef, \@i1);
 480                 $diff .= "became actual line(s) $af...$al:\n";
 481                 $diff .= number_lines ($af, \@i2);
 482             }
 483         }
 484     }
 485
 486     my ($details) = "";
 487     $details .= "$test actual output (line numbers added):\n";
 488     $details .= number_lines (1, \@actual);
 489     $details .= "\n$test expected output (line numbers added):\n";
 490     $details .= number_lines (1, \@expected);
 491     $details .= "\n$diff\n";
 492     $details{$test} = $details;
 493     die "Output differs from expected.  Details at end of file.\n";
 494 }
 495 \f
 496 sub write_grades {
 497     my (@summary) = snarf ("$GRADES_DIR/tests.txt");
 498
 499     my ($ploss) = 0;
 500     my ($tloss) = 0;
 501     my ($total) = 0;
 502     for (my ($i) = 0; $i <= $#summary; $i++) {
 503         local ($_) = $summary[$i];
 504         if (my ($loss, $test) = /^  -(\d+) ([-a-zA-Z0-9]+):/) {
 505             my ($result) = $result{$test} || "Not tested.";
 506
 507             if ($result eq 'ok') {
 508                 splice (@summary, $i, 1);
 509                 $i--;
 510             } else {
 511                 $ploss += $loss;
 512                 $tloss += $loss;
 513                 splice (@summary, $i + 1, 0,
 514                         map ("     $_", split ("\n", $result)));
 515             }
 516         } elsif (my ($ptotal) = /^Score: \/(\d+)$/) {
 517             $total += $ptotal;
 518             $summary[$i] = "Score: " . ($ptotal - $ploss) . "/$ptotal";
 519             splice (@summary, $i, 0, "  All tests passed.") if $ploss == 0;
 520             $ploss = 0;
 521             $i++;
 522         }
 523     }
 524     my ($ts) = "(" . ($total - $tloss) . "/" . $total . ")";
 525     $summary[0] =~ s/\[\[total\]\]/$ts/;
 526
 527     open (SUMMARY, ">tests.out");
 528     print SUMMARY map ("$_\n", @summary);
 529     close (SUMMARY);
 530 }
 531
 532 sub write_details {
 533     open (DETAILS, ">details.out");
 534     my ($n) = 0;
 535     for my $test (@TESTS) {
 536         next if $result{$test} eq 'ok';
 537
 538         my ($details) = $details{$test};
 539         next if !defined ($details) && ! -e "output/$test.run.out";
 540
 541         print DETAILS "\n" if $n++;
 542         print DETAILS "--- $test details ", '-' x (50 - length ($test));
 543         print DETAILS "\n\n";
 544
 545         if (!defined $details) {
 546             $details = "Output:\n\n" . snarf ("output/$test.run.out");
 547         }
 548         print DETAILS $details;
 549
 550         print DETAILS "\n", "-" x 10, "\n\n$extra{$test}"
 551             if defined $extra{$test};
 552     }
 553     close (DETAILS);
 554
 555 }
 556 \f
 557 sub xsystem {
 558     my ($command, %options) = @_;
 559     print "$command\n" if $VERBOSE || $options{VERBOSE};
 560
 561     my ($log) = $options{LOG};
 562     if (defined ($log)) {
 563         $command = "($command) >output/$log.out 2>output/$log.err";
 564     }
 565
 566     my ($pid, $status);
 567     eval {
 568         local $SIG{ALRM} = sub { die "alarm\n" };
 569         alarm $options{TIMEOUT} if defined $options{TIMEOUT};
 570         $pid = fork;
 571         die "fork: $!\n" if !defined $pid;
 572         exec ($command), die "$command: exec: $!\n" if !$pid;
 573         waitpid ($pid, 0);
 574         $status = $?;
 575         alarm 0;
 576     };
 577     if ($@) {
 578         die unless $@ eq "alarm\n";   # propagate unexpected errors
 579         print "Timed out.\n";
 580         kill SIGTERM, $pid;
 581         $status = 0;
 582     }
 583
 584     if (WIFSIGNALED ($status)) {
 585         my ($signal) = WTERMSIG ($status);
 586         die "Interrupted\n" if $signal == SIGINT;
 587         print "Child terminated with signal $signal\n";
 588     }
 589
 590     unlink ("output/$log.err") if defined ($log) && $status == 0;
 591
 592     return $status == 0;
 593 }
 594
 595 sub snarf {
 596     my ($file) = @_;
 597     open (OUTPUT, $file) or die "$file: open: $!\n";
 598     my (@lines) = <OUTPUT>;
 599     chomp (@lines);
 600     close (OUTPUT);
 601     return wantarray ? @lines : join ('', map ("$_\n", @lines));
 602 }
 603
 604 sub files_equal {
 605     my ($a, $b) = @_;
 606     my ($equal);
 607     open (A, "<$a") or die "$a: open: $!\n";
 608     open (B, "<$b") or die "$b: open: $!\n";
 609     if (-s A != -s B) {
 610         $equal = 0;
 611     } else {
 612         my ($sa, $sb);
 613         for (;;) {
 614             sysread (A, $sa, 1024);
 615             sysread (B, $sb, 1024);
 616             $equal = 0, last if $sa ne $sb;
 617             $equal = 1, last if $sa eq '';
 618         }
 619     }
 620     close (A);
 621     close (B);
 622     return $equal;
 623 }
 624
 625 sub file_contains {
 626     my ($file, $expected) = @_;
 627     open (FILE, "<$file") or die "$file: open: $!\n";
 628     my ($actual);
 629     sysread (FILE, $actual, -s FILE);
 630     my ($equal) = $actual eq $expected;
 631     close (FILE);
 632     return $equal;
 633 }
 634
 635 sub number_lines {
 636     my ($ln, $lines) = @_;
 637     my ($out);
 638     for my $line (@$lines) {
 639         chomp $line;
 640         $out .= sprintf "%4d  %s\n", $ln++, $line;
 641     }
 642     return $out;
 643 }