3 # Find the directory that contains the grading files.
6 # Add our Perl library directory to the include path.
8 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
9 -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
10 unshift @INC, "$GRADES_DIR/../lib";
17 our ($hw) = "userprog";
18 our (@TESTS); # Tests to run.
23 if ($#ARGV == 0 && $ARGV[0] eq 'null') {
27 run_and_grade_tests ();
31 parse_cmd_line qw (args-argc args-argv0 args-argvn args-single args-multiple
33 sc-bad-sp sc-bad-arg sc-boundary
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
41 read-normal read-bad-ptr read-boundary read-zero read-stdout
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);
49 clean_dir (), exit if $action eq 'clean';
52 exit if $action eq 'extract';
55 exit if $action eq 'build';
57 run_and_grade_tests ();
60 exit success () if $action eq 'test';
62 assemble_final_grade ();
63 exit success () if $action eq 'assemble';
65 die "Don't know how to '$action'";
67 # Runs $test in directory output/$test.
68 # Returns 'ok' if it went ok, otherwise an explanation.
70 xsystem ("cp $GRADES_DIR/$test.dsk output/$test/fs.dsk",
71 DIE => "cp failed\n");
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 '';
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\"",
91 rename "output/$test/fs.dsk", "output/$test/fs.dsk.keep"
92 if $test eq 'write-normal';
96 sub grade_write_normal {
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;
103 my (@actual) = snarf ($test_txt);
104 my (@expected) = snarf ("$GRADES_DIR/sample.txt");
107 if ($#actual == $#expected) {
109 for my $i (0...$#actual) {
110 $eq = 0 if $actual[$i] ne $expected[$i];
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;
123 die "File written didn't have expected content.\n";
127 sub grade_multi_oom {
129 verify_common (@output);
131 @output = canonicalize_exit_codes (get_core_output (@output));
133 while (my ($m) = $output[0] =~ /^\(multi-oom\) begin (\d+)$/) {
134 die "Child process $m started out of order.\n" if $m != $n;
138 die "Only $n child process(es) started.\n" if $n < 15;
140 # There could be a death notice for a process that didn't get
141 # fully loaded, and/or notices from the loader.
143 && ($output[0] =~ /^multi-oom: exit\(-1\)$/
144 || $output[0] =~ /^load: /)) {
149 die "Output ended unexpectedly before process $n finished.\n"
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$/;
158 chomp ($_ = shift @output);
159 die "Kernel didn't print proper exit message for process $n.\n"
160 if !/^multi-oom: exit\($n\)$/;
162 die "Spurious output at end: '$output[0]'.\n" if @output;
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",
174 die "`pintos get $guest_fn' failed - $result\n"