thread: Properly protect 'all_list' around insertion.
[pintos-anon] / ta-advice / run-tests
1 #! /usr/bin/perl -w
2
3 use strict;
4 use Getopt::Long;
5 use POSIX;
6
7 our ($PINTOSDIR) = "/usr/class/cs140/pintos/pintos";
8
9 our ($verbose) = 0;
10 our ($start) = -d 'pintos/src' ? 4 : 1;
11 our ($stop) = 7;
12
13 GetOptions ("v|verbose+" => \$verbose,
14             "h|help" => sub { usage (0) },
15             "r|replace" => sub {
16                 die "Can't start from step 2: pintos/src does not exist\n"
17                   if ! -d 'pintos/src';
18                 $start = 2;
19             },
20             "x|extract" => sub { $stop = 2 },
21             "c|clean" => sub { $stop = 3 },
22             "b|build" => sub { $stop = 4 },
23             "t|test" => sub { $stop = 6 })
24   or die "Malformed command line; use --help for help.\n";
25
26 die "Exactly one non-option argument required; use --help for help.\n"
27   if @ARGV != 1;
28
29 my (@valid_projects) = ('threads', 'userprog', 'vm', 'filesys');
30 my ($project) = $ARGV[0];
31 $project = $valid_projects[$project - 1] if $project =~ /^[1234]$/;
32 die "Unknown project \"$project\"; use --help for help.\n"
33   if !grep ($_ eq $project, @valid_projects);
34
35 sub usage {
36     my ($exitcode) = @_;
37     print <<EOF;
38 run-tests, runs tests for grading a single submitted project
39
40 usage: run-tests PROJECT
41 where PROJECT is a project name (threads, userprog, vm, filesys)
42 or number (1-4).
43
44 Invoke from a directory containing a student tarball named by
45 the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz,
46 or a pintos/src directory containing a student submission.
47
48 Workflow:
49   1. Extracts the source tree into pintos/src.
50   2. Replaces the existing pintos/src/tests directory by a pristine
51      copy, which must be available in $PINTOSDIR.
52   3. Cleans the source tree.
53   4. Builds the source tree.
54   5. Runs the tests on the source tree and grades them.
55   6. Copies the grade report to tests.out.
56   7. Cleans the source tree again.
57
58 Note:
59   If pintos/src already exists, run-tests starts from step 4.
60   To force it to start from step 1, remove the pintos directory.
61   To force it to start from step 2, use --replace.
62
63 Options:
64   -r, --replace      Start at step 2.
65   -x, --extract      Stop after step 2.
66   -c, --clean        Stop after step 3.
67   -b, --build        Stop after step 4.
68   -t, --test         Stop after step 6.
69   -v, --verbose      Print command lines of subcommands before executing them.
70   -h, --help         Print this help message.
71 EOF
72     exit $exitcode;
73 }
74
75 if (do_step (1)) {
76     my ($tarball) = choose_tarball ();
77
78     print "Extracting $tarball...\n";
79     xsystem ("tar xzf $tarball", DIE => "extraction failed\n");
80 }
81
82 if (do_step (2)) {
83     print "Replacing tests with pristine copy...\n";
84     xsystem ("rm -rf pintos/src/tests",
85              DIE => "removal of old tests failed\n");
86     xsystem ("cp -pR $PINTOSDIR/src/tests pintos/src/tests",
87              DIE => "replacement of tests failed\n");
88 }
89
90 if (do_step (3)) {
91     print "Cleaning...\n";
92     xsystem ("cd pintos/src && make clean", DIE => "clean failed");
93 }
94
95 if (do_step (4)) {
96     print "Building...\n";
97     xsystem ("cd pintos/src/$project && make", DIE => "build failed");
98 }
99
100 if (do_step (5)) {
101     print "Grading...\n";
102     xsystem ("cd pintos/src/$project && make grade", DIE => "grade failed");
103 }
104
105 if (do_step (6)) {
106     print "Saving grade report to tests.out...\n";
107     xsystem ("cp pintos/src/$project/build/grade tests.out",
108              DIE => "copy failed");
109     xsystem ("(cd pintos/src/$project/build && find tests -name '*.output' "
110              . " | xargs grep '^hd[01]:[01]: [0-9]') > hdd.stats");
111 }
112
113 if (do_step (7)) {
114     print "Cleaning...\n";
115     xsystem ("cd pintos/src && make clean", DIE => "clean failed");
116 }
117
118 # do_step ($N)
119 #
120 # Returns true if step $N should be executed.
121 sub do_step {
122     my ($n) = @_;
123     return $n >= $start && $n <= $stop;
124 }
125
126 # Returns the name of the tarball to extract.
127 sub choose_tarball {
128     my (@tarballs)
129         = grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
130                 glob ("*.tar.gz"));
131     die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
132         if scalar (@tarballs) == 0;
133
134     if (@tarballs > 1) {
135         # Sort tarballs in order by time.
136         @tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;
137
138         print "Multiple tarballs:\n";
139         print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
140         print "Choosing $tarballs[$#tarballs]\n";
141     }
142     return $tarballs[$#tarballs];
143 }
144
145 # Extract the date within a tarball name into a string that compares
146 # lexicographically in chronological order.
147 sub ext_mdyHMS {
148     my ($s) = @_;
149     my ($ms, $d, $y, $H, $M, $S) =
150         $s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
151         or die;
152     my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
153         or die;
154     return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
155 }
156
157 sub xsystem {
158     my ($command, %options) = @_;
159     print "$command\n" if $verbose || $options{VERBOSE};
160
161     my ($log) = $options{LOG};
162
163     my ($pid, $status);
164     eval {
165         local $SIG{ALRM} = sub { die "alarm\n" };
166         alarm $options{TIMEOUT} if defined $options{TIMEOUT};
167         $pid = fork;
168         die "fork: $!\n" if !defined $pid;
169         if (!$pid) {
170             if (defined $log) {
171                 open (STDOUT, ">output/$log.out");
172                 open (STDERR, ">output/$log.err");
173             }
174             exec ($command);
175             exit (-1);
176         }
177         waitpid ($pid, 0);
178         $status = $?;
179         alarm 0;
180     };
181
182     my ($result);
183     if ($@) {
184         die unless $@ eq "alarm\n";   # propagate unexpected errors
185         my ($i);
186         for ($i = 0; $i < 10; $i++) {
187             kill ('SIGTERM', $pid);
188             sleep (1);
189             my ($retval) = waitpid ($pid, WNOHANG);
190             last if $retval == $pid || $retval == -1;
191             print "Timed out - Waiting for $pid to die" if $i == 0;
192             print ".";
193         }
194         print "\n" if $i;
195         $result = 'timeout';
196     } else {
197         if (WIFSIGNALED ($status)) {
198             my ($signal) = WTERMSIG ($status);
199             die "Interrupted\n" if $signal == SIGINT;
200             print "Child terminated with signal $signal\n";
201         }
202
203         my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
204         $result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
205             ? "ok" : "error";
206     }
207
208
209     if ($result eq 'error' && defined $options{DIE}) {
210         my ($msg) = $options{DIE};
211         if (defined ($log)) {
212             chomp ($msg);
213             $msg .= "; see output/$log.err and output/$log.out for details\n";
214         }
215         die $msg;
216     } elsif ($result ne 'error' && defined ($log)) {
217         unlink ("output/$log.err");
218     }
219
220     return $result;
221 }