pintos-os.org Git - pintos-anon/blob - grading/lib/Pintos/Grading.pm

   1 use strict;
   2 use warnings;
   3
   4 our ($test);
   5
   6 our ($GRADES_DIR);
   7 our ($verbose);
   8 our (%args);
   9
  10 use Getopt::Long;
  11 use POSIX;
  12 \f
  13 # Source tarballs.
  14
  15 # Extracts the group's source files into pintos/src,
  16 # applies any patches providing in the grading directory,
  17 # and installs a default pintos/src/constants.h
  18 sub obtain_sources {
  19     # Nothing to do if we already have a source tree.
  20     return if -d "pintos";
  21
  22     my ($tarball) = choose_tarball ();
  23
  24     # Extract sources.
  25     print "Creating pintos/src...\n";
  26     mkdir "pintos" or die "pintos: mkdir: $!\n";
  27     mkdir "pintos/src" or die "pintos/src: mkdir: $!\n";
  28
  29     print "Extracting $tarball into pintos/src...\n";
  30     xsystem ("cd pintos/src && tar xzf ../../$tarball",
  31              DIE => "extraction failed\n");
  32
  33     # Run custom script for this submission, if provided.
  34     if (-e "fixme.sh") {
  35         print "Running fixme.sh...\n";
  36         xsystem ("sh -e fixme.sh", DIE => "fix script failed\n");
  37     } else {
  38         print "No fixme.sh, assuming no custom changes needed.\n";
  39     }
  40
  41     # Apply patches from grading directory.
  42     # Patches are applied in lexicographic order, so they should
  43     # probably be named 00-debug.patch, 01-bitmap.patch, etc.
  44     # Filenames in patches should be in the format pintos/src/...
  45     print "Patching...\n";
  46     for my $patch (glob ("$GRADES_DIR/patches/*.patch")) {
  47         my ($stem);
  48         ($stem = $patch) =~ s%^$GRADES_DIR/patches/%% or die;
  49         xsystem ("patch -fs -p0 < $patch",
  50                  LOG => $stem, DIE => "applying patch $stem failed\n");
  51     }
  52
  53     # Install default pintos/src/constants.h.
  54     open (CONSTANTS, ">pintos/src/constants.h")
  55         or die "constants.h: create: $!\n";
  56     print CONSTANTS "#define THREAD_JOIN_IMPLEMENTED 1\n";
  57     close CONSTANTS;
  58 }
  59
  60 # Returns the name of the tarball to extract.
  61 sub choose_tarball {
  62     my (@tarballs)
  63         = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
  64                 glob ("*.tar.gz"));
  65     die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
  66         if scalar (@tarballs) == 0;
  67
  68     if (@tarballs > 1) {
  69         # Sort tarballs in order by time.
  70         @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
  71
  72         print "Multiple tarballs:";
  73         print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
  74         print "Choosing $tarballs[$#tarballs]\n";
  75     }
  76     return $tarballs[$#tarballs];
  77 }
  78
  79 # Extract the date within a tarball name into a string that compares
  80 # lexicographically in chronological order.
  81 sub ext_mdyHMS {
  82     my ($s) = @_;
  83     my ($ms, $d, $y, $H, $M, $S) =
  84         $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
  85         or die;
  86     my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
  87         or die;
  88     return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
  89 }
  90 \f
  91 # Compiling.
  92
  93 sub compile {
  94     print "Compiling...\n";
  95     xsystem ("cd pintos/src/filesys && make", LOG => "make")
  96         or return "compile error";
  97 }
  98 \f
  99
 100 sub xsystem {
 101     my ($command, %options) = @_;
 102     print "$command\n" if $verbose || $options{VERBOSE};
 103
 104     my ($log) = $options{LOG};
 105
 106     my ($pid, $status);
 107     eval {
 108         local $SIG{ALRM} = sub { die "alarm\n" };
 109         alarm $options{TIMEOUT} if defined $options{TIMEOUT};
 110         $pid = fork;
 111         die "fork: $!\n" if !defined $pid;
 112         if (!$pid) {
 113             if (defined $log) {
 114                 open (STDOUT, ">output/$log.out");
 115                 open (STDERR, ">output/$log.err");
 116             }
 117             exec ($command);
 118             exit (-1);
 119         }
 120         waitpid ($pid, 0);
 121         $status = $?;
 122         alarm 0;
 123     };
 124
 125     my ($result);
 126     if ($@) {
 127         die unless $@ eq "alarm\n";   # propagate unexpected errors
 128         my ($i);
 129         for ($i = 0; $i < 10; $i++) {
 130             kill ('SIGTERM', $pid);
 131             sleep (1);
 132             my ($retval) = waitpid ($pid, WNOHANG);
 133             last if $retval == $pid || $retval == -1;
 134             print "Timed out - Waiting for $pid to die" if $i == 0;
 135             print ".";
 136         }
 137         print "\n" if $i;
 138         $result = 'timeout';
 139     } else {
 140         if (WIFSIGNALED ($status)) {
 141             my ($signal) = WTERMSIG ($status);
 142             die "Interrupted\n" if $signal == SIGINT;
 143             print "Child terminated with signal $signal\n";
 144         }
 145
 146         my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
 147         $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
 148             ? "ok" : "error";
 149     }
 150
 151
 152     if ($result eq 'error' && defined $options{DIE}) {
 153         my ($msg) = $options{DIE};
 154         if (defined ($log)) {
 155             chomp ($msg);
 156             $msg .= "; see output/$log.err and output/$log.out for details\n";
 157         }
 158         die $msg;
 159     } elsif ($result ne 'error' && defined ($log)) {
 160         unlink ("output/$log.err");
 161     }
 162
 163     return $result;
 164 }
 165 \f
 166 sub get_test_result {
 167     my ($cache_file) = "output/$test/run.result";
 168     # Reuse older results if any.
 169     if (open (RESULT, "<$cache_file")) {
 170         my ($result);
 171         $result = <RESULT>;
 172         chomp $result;
 173         close (RESULT);
 174         return $result;
 175     }
 176
 177     # If there's residue from an earlier test, move it to .old.
 178     # If there's already a .old, delete it.
 179     xsystem ("rm -rf output/$test.old", VERBOSE => 1) if -d "output/$test.old";
 180     rename "output/$test", "output/$test.old" or die "rename: $!\n"
 181         if -d "output/$test";
 182
 183     # Run the test.
 184     my ($result) = run_test ($test);
 185
 186     # Save the results for later.
 187     open (DONE, ">$cache_file") or die "$cache_file: create: $!\n";
 188     print DONE "$result\n";
 189     close (DONE);
 190
 191     return $result;
 192 }
 193
 194 # Creates an output directory for the test,
 195 # creates all the files needed
 196 sub run_test {
 197     # Make output directory.
 198     mkdir "output/$test";
 199
 200     my ($fs_size) = $test ne 'grow-too-big' ? 2 : .25;
 201     xsystem ("pintos make-disk output/$test/fs.dsk $fs_size >/dev/null 2>&1",
 202              DIE => "failed to create file system disk");
 203     xsystem ("pintos make-disk output/$test/swap.dsk 2 >/dev/null 2>&1",
 204              DIE => "failed to create swap disk");
 205
 206     # Format disk, install test.
 207     my ($pintos_base_cmd) =
 208         "pintos "
 209         . "--os-disk=pintos/src/filesys/build/os.dsk "
 210         . "--fs-disk=output/$test/fs.dsk "
 211         . "--swap-disk=output/$test/swap.dsk "
 212         . "-v";
 213     unlink ("output/$test/fs.dsk", "output/$test/swap.dsk"),
 214     return "format/put error"
 215         if xsystem ("$pintos_base_cmd put -f $GRADES_DIR/$test $test",
 216                     LOG => "$test/put", TIMEOUT => 60, EXPECT => 1) ne 'ok';
 217
 218     my (@extra_files);
 219     push (@extra_files, "child-syn-read") if $test eq 'syn-read';
 220     push (@extra_files, "child-syn-wrt") if $test eq 'syn-write';
 221     push (@extra_files, "child-syn-rw") if $test eq 'syn-rw';
 222     for my $fn (@extra_files) {
 223         return "format/put error"
 224             if xsystem ("$pintos_base_cmd put $GRADES_DIR/$fn $fn",
 225                         LOG => "$test/put-$fn", TIMEOUT => 60, EXPECT => 1)
 226                ne 'ok';
 227     }
 228
 229     # Run.
 230     my ($timeout) = 120;
 231     my ($testargs) = defined ($args{$test}) ? " $args{$test}" : "";
 232     my ($retval) =
 233         xsystem ("$pintos_base_cmd run -q -ex \"$test$testargs\"",
 234                  LOG => "$test/run", TIMEOUT => $timeout, EXPECT => 1);
 235     my ($result);
 236     if ($retval eq 'ok') {
 237         $result = "ok";
 238     } elsif ($retval eq 'timeout') {
 239         $result = "Timed out after $timeout seconds";
 240     } elsif ($retval eq 'error') {
 241         $result = "Bochs error";
 242     } else {
 243         die;
 244     }
 245     unlink ("output/$test/fs.dsk", "output/$test/swap.dsk");
 246     return $result;
 247 }
 248
 249 # Grade the test.
 250 sub grade_test {
 251     # Read test output.
 252     my (@output) = snarf ("output/$test/run.out");
 253
 254     # If there's a function "grade_$test", use it to evaluate the output.
 255     # If there's a file "$GRADES_DIR/$test.exp", compare its contents
 256     # against the output.
 257     # (If both exist, prefer the function.)
 258     my ($grade_func) = "grade_$test";
 259     $grade_func =~ s/-/_/g;
 260     if (-e "$GRADES_DIR/$test.exp" && !defined (&$grade_func)) {
 261         eval {
 262             verify_common (@output);
 263             compare_output ("$GRADES_DIR/$test.exp", @output);
 264         }
 265     } else {
 266         eval "$grade_func (\@output)";
 267     }
 268     if ($@) {
 269         die $@ if $@ =~ /at \S+ line \d+$/;
 270         return $@;
 271     }
 272     return "ok";
 273 }
 274
 275 sub c {
 276     print "$test\n";
 277 }
 278
 279 1;