Move problem 1-2 (join) into project 2 as the "wait" system call.
[pintos-anon] / 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                    wait-simple wait-twice wait-killed wait-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 (["--os-disk=pintos/src/userprog/build/os.dsk",
86                                 "--fs-disk=output/$test/fs.dsk",
87                                 "-v", "run", "-q", "-ex", "$test$args"],
88                                LOG => "$test/run",
89                                TIMEOUT => $timeout);
90     rename "output/$test/fs.dsk", "output/$test/fs.dsk.keep"
91         if $test eq 'write-normal';
92     return $result;
93 }
94 \f
95 sub grade_write_normal {
96     my (@output) = @_;
97     verify_common (@output);
98     compare_output ("$GRADES_DIR/write-normal.exp", @output);
99     my ($test_txt) = "output/$test/test.txt";
100     get_file ("test.txt", $test_txt) if ! -e $test_txt;
101
102     my (@actual) = snarf ($test_txt);
103     my (@expected) = snarf ("$GRADES_DIR/sample.txt");
104
105     my ($eq);
106     if ($#actual == $#expected) {
107         $eq = 1;
108         for my $i (0...$#actual) {
109             $eq = 0 if $actual[$i] ne $expected[$i];
110         }
111     } else {
112         $eq = 0;
113     }
114     if (!$eq) {
115         my ($details);
116         $details = "Expected file content:\n";
117         $details .= join ('', map ("  $_\n", @expected));
118         $details .= "Actual file content:\n";
119         $details .= join ('', map ("  $_\n", @actual));
120         $extra{$test} = $details;
121
122         die "File written didn't have expected content.\n";
123     }
124 }
125
126 sub grade_multi_oom {
127     my (@output) = @_;
128     verify_common (@output);
129
130     @output = canonicalize_exit_codes (get_core_output (@output));
131     my ($n) = 0;
132     while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) {
133         die "Child process $m started out of order.\n" if $m != $n;
134         $n = $m + 1;
135         shift @output;
136     }
137     die "Only $n child process(es) started.\n" if $n < 15;
138
139     # There could be a death notice for a process that didn't get
140     # fully loaded, and/or notices from the loader.
141     while (@output > 0
142            && ($output[0] =~ /^multi-oom: exit\(-1\)$/
143                || $output[0] =~ /^load: /)) {
144         shift @output;
145     }
146
147     while (--$n >= 0) {
148         die "Output ended unexpectedly before process $n finished.\n"
149             if @output < 2;
150
151         local ($_);
152         chomp ($_ = shift @output);
153         die "Found '$_' expecting 'end' message.\n" if !/^\(multi-oom\) end/;
154         die "Child process $n ended out of order.\n"
155             if !/^\(multi-oom\) end $n$/;
156
157         chomp ($_ = shift @output);
158         die "Kernel didn't print proper exit message for process $n.\n"
159             if !/^multi-oom: exit\($n\)$/;
160     }
161     die "Spurious output at end: '$output[0]'.\n" if @output;
162 }
163
164 sub get_file {
165     my ($guest_fn, $host_fn) = @_;
166     my ($result) = run_pintos (["--os-disk=pintos/src/userprog/build/os.dsk",
167                                 "--fs-disk=output/$test/fs.dsk.keep",
168                                 "-v", "get", "$guest_fn", "$host_fn"],
169                                LOG => "$test/get-$guest_fn",
170                                TIMEOUT => 10);
171     die "`pintos get $guest_fn' failed - $result\n"
172         if $result ne 'ok';
173 }