#! /usr/bin/perl use strict; use warnings; @ARGV == 3 || die; my ($src_dir, $results_file, $grading_file) = @ARGV; # Read pass/file verdicts from $results_file. open (RESULTS, '<', $results_file) || die "$results_file: open: $!\n"; my (%verdicts, %verdict_counts); while () { my ($verdict, $test) = /^(pass|FAIL) (.*)$/ or die; $verdicts{$test} = $verdict eq 'pass'; } close RESULTS; my (@failures); my (@overall, @rubrics, @summary); my ($pct_actual, $pct_possible) = (0, 0); # Read grading file. my (@items); open (GRADING, '<', $grading_file) || die "$grading_file: open: $!\n"; while () { s/#.*//; next if /^\s*$/; my ($max_pct, $rubric_suffix) = /^\s*(\d+(?:\.\d+)?)%\t(.*)/ or die; my ($dir) = $rubric_suffix =~ /^(.*)\//; my ($rubric_file) = "$src_dir/$rubric_suffix"; open (RUBRIC, '<', $rubric_file) or die "$rubric_file: open: $!\n"; # Rubric file must begin with title line. my $title = ; chomp $title; $title =~ s/:$// or die; $title .= " ($rubric_suffix):"; push (@rubrics, $title); my ($score, $possible) = (0, 0); my ($cnt, $passed) = (0, 0); my ($was_score) = 0; while () { chomp; push (@rubrics, "\t$_"), next if /^-/; push (@rubrics, ""), next if /^\s*$/; my ($poss, $name) = /^(\d+)\t(.*)$/ or die; my ($test) = "$dir/$name"; my ($points) = 0; if (!defined $verdicts{$test}) { push (@overall, "warning: $test not tested, assuming failure"); } elsif ($verdicts{$test}) { $points = $poss; $passed++; } push (@failures, $test) if !$points; $verdict_counts{$test}++; push (@rubrics, sprintf ("\t%4s%2d/%2d %s", $points ? '' : '**', $points, $poss, $test)); $score += $points; $possible += $poss; $cnt++; } close (RUBRIC); push (@rubrics, ""); push (@rubrics, "\t- Section summary."); push (@rubrics, sprintf ("\t%4s%3d/%3d %s", '', $passed, $cnt, 'tests passed')); push (@rubrics, sprintf ("\t%4s%3d/%3d %s", '', $score, $possible, 'points subtotal')); push (@rubrics, ''); my ($pct) = ($score / $possible) * $max_pct; push (@summary, sprintf ("%-45s %3d/%3d %5.1f%%/%5.1f%%", $rubric_suffix, $score, $possible, $pct, $max_pct)); $pct_actual += $pct; $pct_possible += $max_pct; } close GRADING; my ($sum_line) = "--------------------------------------------- --- --- ------ ------"; unshift (@summary, "SUMMARY BY TEST SET", '', sprintf ("%-45s %3s %3s %6s %6s", "Test Set", "Pts", "Max", "% Ttl", "% Max"), $sum_line); push (@summary, $sum_line, sprintf ("%-45s %3s %3s %5.1f%%/%5.1f%%", 'Total', '', '', $pct_actual, $pct_possible)); unshift (@rubrics, "SUMMARY OF INDIVIDUAL TESTS", ''); foreach my $name (keys (%verdicts)) { my ($count) = $verdict_counts{$name}; if (!defined ($count) || $count != 1) { if (!defined ($count) || !$count) { push (@overall, "warning: test $name doesn't count for grading"); } else { push (@overall, "warning: test $name counted $count times in grading"); } } } push (@overall, sprintf ("TOTAL TESTING SCORE: %.1f%%", $pct_actual)); if (sprintf ("%.1f", $pct_actual) eq sprintf ("%.1f", $pct_possible)) { push (@overall, "ALL TESTED PASSED -- PERFECT SCORE"); } my (@divider) = ('', '- ' x 38, ''); print map ("$_\n", @overall, @divider, @summary, @divider, @rubrics); for my $test (@failures) { print map ("$_\n", @divider); print "DETAILS OF $test FAILURE:\n\n"; if (open (RESULT, '<', "$test.result")) { my $first_line = ; my ($cnt) = 0; while () { print; $cnt++; } close (RESULT); } if (open (OUTPUT, '<', "$test.output")) { print "\nOUTPUT FROM $test:\n\n"; my ($panics, $boots) = (0, 0); while () { if (/PANIC/ && ++$panics > 2) { print "[...details of additional panic(s) omitted...]\n"; last; } print; if (/Pintos booting/ && ++$boots > 1) { print "[...details of reboot(s) omitted...]\n"; last; } } close (OUTPUT); } }