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

   1 #! /usr/bin/perl
   2
   3 # Find the directory that contains the grading files.
   4 our ($GRADES_DIR);
   5
   6 # Add our Perl library directory to the include path.
   7 BEGIN {
   8     ($GRADES_DIR = $0) =~ s#/[^/]+$##;
   9     -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
  10     unshift @INC, "$GRADES_DIR/../lib";
  11 }
  12
  13 use warnings;
  14 use strict;
  15 use Pintos::Grading;
  16
  17 our ($hw) = "userprog";
  18 our (@TESTS);           # Tests to run.
  19 our ($test);
  20 our (%extra);
  21 our ($action);
  22
  23 if ($#ARGV == 0 && $ARGV[0] eq 'null') {
  24     @TESTS = ('null');
  25     extract_sources ();
  26     build ();
  27     run_and_grade_tests ();
  28     exit success ();
  29 }
  30
  31 parse_cmd_line qw (args-argc args-argv0 args-argvn args-single args-multiple
  32                    args-dbl-space
  33                    sc-bad-sp sc-bad-arg sc-boundary
  34                    halt exit
  35                    create-normal create-empty create-null create-bad-ptr
  36                    create-long create-exists create-bound
  37                    open-normal open-missing open-boundary open-empty open-null
  38                    open-bad-ptr open-twice
  39                    close-normal close-twice close-stdin close-stdout
  40                    close-bad-fd
  41                    read-normal read-bad-ptr read-boundary read-zero read-stdout
  42                    read-bad-fd
  43                    write-normal write-bad-ptr write-boundary write-zero
  44                    write-stdin write-bad-fd
  45                    exec-once exec-arg exec-multiple exec-missing exec-bad-ptr
  46                    join-simple join-twice join-killed join-bad-pid
  47                    multi-recurse multi-oom multi-child-fd);
  48
  49 clean_dir (), exit if $action eq 'clean';
  50
  51 extract_sources ();
  52 exit if $action eq 'extract';
  53
  54 build ();
  55 exit if $action eq 'build';
  56
  57 run_and_grade_tests ();
  58 write_grades ();
  59 write_details ();
  60 exit success () if $action eq 'test';
  61
  62 assemble_final_grade ();
  63 exit success () if $action eq 'assemble';
  64
  65 die "Don't know how to '$action'";
  66
  67 # Runs $test in directory output/$test.
  68 # Returns 'ok' if it went ok, otherwise an explanation.
  69 sub run_test {
  70     xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk",
  71              DIE => "cp failed\n");
  72
  73     my ($args) = "";
  74     $args = 'some arguments for you!'
  75         if grep ($_ eq $test, qw(args-argc args-argv0
  76                                  args-argvn args-multiple));
  77     $args = 'onearg' if $test eq 'args-single';
  78     $args = 'two  args' if $test eq 'args-dbl-space';
  79     $args = '15' if $test eq 'multi-recurse';
  80     $args = '0' if $test eq 'multi-oom';
  81     $args = " $args" if $args ne '';
  82
  83     # Run.
  84     my ($timeout) = $test !~ /^multi-/ ? 10 : 600;
  85     my ($result) = run_pintos ("pintos "
  86                                . "--os-disk=pintos/src/userprog/build/os.dsk "
  87                                . "--fs-disk=output/$test/fs.dsk "
  88                                . "-v run -q -ex \"$test$args\"",
  89                                LOG => "$test/run",
  90                                TIMEOUT => $timeout);
  91     rename "output/$test/fs.dsk", "output/$test/fs.dsk.keep"
  92         if $test eq 'write-normal';
  93     return $result;
  94 }
  95 \f
  96 sub grade_write_normal {
  97     my (@output) = @_;
  98     verify_common (@output);
  99     compare_output ("$GRADES_DIR/write-normal.exp", @output);
 100     my ($test_txt) = "output/$test/test.txt";
 101     get_file ("test.txt", $test_txt) if ! -e $test_txt;
 102
 103     my (@actual) = snarf ($test_txt);
 104     my (@expected) = snarf ("$GRADES_DIR/sample.txt");
 105
 106     my ($eq);
 107     if ($#actual == $#expected) {
 108         $eq = 1;
 109         for my $i (0...$#actual) {
 110             $eq = 0 if $actual[$i] ne $expected[$i];
 111         }
 112     } else {
 113         $eq = 0;
 114     }
 115     if (!$eq) {
 116         my ($details);
 117         $details = "Expected file content:\n";
 118         $details .= join ('', map ("  $_\n", @expected));
 119         $details .= "Actual file content:\n";
 120         $details .= join ('', map ("  $_\n", @actual));
 121         $extra{$test} = $details;
 122
 123         die "File written didn't have expected content.\n";
 124     }
 125 }
 126
 127 sub grade_multi_oom {
 128     my (@output) = @_;
 129     verify_common (@output);
 130
 131     @output = canonicalize_exit_codes (get_core_output (@output));
 132     my ($n) = 0;
 133     while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) {
 134         die "Child process $m started out of order.\n" if $m != $n;
 135         $n = $m + 1;
 136         shift @output;
 137     }
 138     die "Only $n child process(es) started.\n" if $n < 15;
 139
 140     # There could be a death notice for a process that didn't get
 141     # fully loaded, and/or notices from the loader.
 142     while (@output > 0
 143            && ($output[0] =~ /^multi-oom: exit\(-1\)$/
 144                || $output[0] =~ /^load: /)) {
 145         shift @output;
 146     }
 147
 148     while (--$n >= 0) {
 149         die "Output ended unexpectedly before process $n finished.\n"
 150             if @output < 2;
 151
 152         local ($_);
 153         chomp ($_ = shift @output);
 154         die "Found '$_' expecting 'end' message.\n" if !/^\(multi-oom\) end/;
 155         die "Child process $n ended out of order.\n"
 156             if !/^\(multi-oom\) end $n$/;
 157
 158         chomp ($_ = shift @output);
 159         die "Kernel didn't print proper exit message for process $n.\n"
 160             if !/^multi-oom: exit\($n\)$/;
 161     }
 162     die "Spurious output at end: '$output[0]'.\n" if @output;
 163 }
 164
 165 sub get_file {
 166     my ($guest_fn, $host_fn) = @_;
 167     my ($result) = run_pintos ("pintos "
 168                                . "--os-disk=pintos/src/userprog/build/os.dsk "
 169                                . "--fs-disk=output/$test/fs.dsk.keep "
 170                                . "-v get $guest_fn $host_fn",
 171                                LOG => "$test/get-$guest_fn",
 172                                TIMEOUT => 10);
 173     die "`pintos get $guest_fn' failed - $result\n"
 174         if $result ne 'ok';
 175 }