pintos: Avoid apparent name collision in definition of SIGALRM subroutine.
[pintos-anon] / src / tests / make-grade
1 #! /usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 @ARGV == 3 || die;
7 my ($src_dir, $results_file, $grading_file) = @ARGV;
8
9 # Read pass/file verdicts from $results_file.
10 open (RESULTS, '<', $results_file) || die "$results_file: open: $!\n";
11 my (%verdicts, %verdict_counts);
12 while (<RESULTS>) {
13     my ($verdict, $test) = /^(pass|FAIL) (.*)$/ or die;
14     $verdicts{$test} = $verdict eq 'pass';
15 }
16 close RESULTS;
17
18 my (@failures);
19 my (@overall, @rubrics, @summary);
20 my ($pct_actual, $pct_possible) = (0, 0);
21
22 # Read grading file.
23 my (@items);
24 open (GRADING, '<', $grading_file) || die "$grading_file: open: $!\n";
25 while (<GRADING>) {
26     s/#.*//;
27     next if /^\s*$/;
28     my ($max_pct, $rubric_suffix) = /^\s*(\d+(?:\.\d+)?)%\t(.*)/ or die;
29     my ($dir) = $rubric_suffix =~ /^(.*)\//;
30     my ($rubric_file) = "$src_dir/$rubric_suffix";
31     open (RUBRIC, '<', $rubric_file) or die "$rubric_file: open: $!\n";
32
33     # Rubric file must begin with title line.
34     my $title = <RUBRIC>;
35     chomp $title;
36     $title =~ s/:$// or die;
37     $title .= " ($rubric_suffix):";
38     push (@rubrics, $title);
39
40     my ($score, $possible) = (0, 0);
41     my ($cnt, $passed) = (0, 0);
42     my ($was_score) = 0;
43     while (<RUBRIC>) {
44         chomp;
45         push (@rubrics, "\t$_"), next if /^-/;
46         push (@rubrics, ""), next if /^\s*$/;
47         my ($poss, $name) = /^(\d+)\t(.*)$/ or die;
48         my ($test) = "$dir/$name";
49         my ($points) = 0;
50         if (!defined $verdicts{$test}) {
51             push (@overall, "warning: $test not tested, assuming failure");
52         } elsif ($verdicts{$test}) {
53             $points = $poss;
54             $passed++;
55         }
56         push (@failures, $test) if !$points;
57         $verdict_counts{$test}++;
58         push (@rubrics, sprintf ("\t%4s%2d/%2d %s",
59                                  $points ? '' : '**', $points, $poss, $test));
60         $score += $points;
61         $possible += $poss;
62         $cnt++;
63     }
64     close (RUBRIC);
65
66     push (@rubrics, "");
67     push (@rubrics, "\t- Section summary.");
68     push (@rubrics, sprintf ("\t%4s%3d/%3d %s",
69                              '', $passed, $cnt, 'tests passed'));
70     push (@rubrics, sprintf ("\t%4s%3d/%3d %s",
71                              '', $score, $possible, 'points subtotal'));
72     push (@rubrics, '');
73
74     my ($pct) = ($score / $possible) * $max_pct;
75     push (@summary, sprintf ("%-45s %3d/%3d %5.1f%%/%5.1f%%",
76                              $rubric_suffix,
77                              $score, $possible,
78                              $pct, $max_pct));
79     $pct_actual += $pct;
80     $pct_possible += $max_pct;
81 }
82 close GRADING;
83
84 my ($sum_line)
85   = "--------------------------------------------- --- --- ------ ------";
86 unshift (@summary,
87          "SUMMARY BY TEST SET",
88          '',
89          sprintf ("%-45s %3s %3s %6s %6s",
90                   "Test Set", "Pts", "Max", "% Ttl", "% Max"),
91          $sum_line);
92 push (@summary,
93       $sum_line,
94       sprintf ("%-45s %3s %3s %5.1f%%/%5.1f%%",
95                'Total', '', '', $pct_actual, $pct_possible));
96
97 unshift (@rubrics,
98          "SUMMARY OF INDIVIDUAL TESTS",
99          '');
100
101 foreach my $name (keys (%verdicts)) {
102     my ($count) = $verdict_counts{$name};
103     if (!defined ($count) || $count != 1) {
104         if (!defined ($count) || !$count) {
105             push (@overall, "warning: test $name doesn't count for grading");
106         } else {
107             push (@overall,
108                   "warning: test $name counted $count times in grading");
109         }
110     }
111 }
112 push (@overall, sprintf ("TOTAL TESTING SCORE: %.1f%%", $pct_actual));
113 if (sprintf ("%.1f", $pct_actual) eq sprintf ("%.1f", $pct_possible)) {
114     push (@overall, "ALL TESTED PASSED -- PERFECT SCORE");
115 }
116
117 my (@divider) = ('', '- ' x 38, '');
118
119 print map ("$_\n", @overall, @divider, @summary, @divider, @rubrics);
120
121 for my $test (@failures) {
122     print map ("$_\n", @divider);
123     print "DETAILS OF $test FAILURE:\n\n";
124
125     if (open (RESULT, '<', "$test.result")) {
126         my $first_line = <RESULT>;
127         my ($cnt) = 0;
128         while (<RESULT>) {
129             print;
130             $cnt++;
131         }
132         close (RESULT);
133     }
134
135     if (open (OUTPUT, '<', "$test.output")) {
136         print "\nOUTPUT FROM $test:\n\n";
137     
138         my ($panics, $boots) = (0, 0);
139         while (<OUTPUT>) {
140             if (/PANIC/ && ++$panics > 2) {
141                 print "[...details of additional panic(s) omitted...]\n";
142                 last;
143             }
144             print;
145             if (/Pintos booting/ && ++$boots > 1) {
146                 print "[...details of reboot(s) omitted...]\n";
147                 last;
148             }
149         }
150         close (OUTPUT);
151     }
152 }