#!/usr/bin/perl # tpr04b.pl - tsort golf game test program VERSION 1.9 use strict; my $script = 'tsort.pl'; # ----------------------------------------------------- # [data, should_fail] my @cases = ( [<; close IN; for($contents) { tr/\r//; # remove all CRs s/\s*\z/\n/; # trim end; /^#!perl\s/ or die "Script does not start with #!perl\\s"; /\brand\b/ and die "Script contains rand() function"; /[^ -~\n\t]/ and die "Script contains illegal character @{[ord $&]}"; } my $have_stderr_redirect = 1; if ($^O eq 'MSWin32') { if (Win32::IsWinNT()) { print "You are running Windows NT/2000\n"; } else { print "You are running Windows, but not Windows NT/2000\n"; $have_stderr_redirect = 0; } } else { print "Congratulations! You are not running Windows.\n"; } sub GolfScore { my $golf = length($contents) - 8; my ($body) = $contents =~ /#!perl(.*)\n\z/s; my $whitespace = () = $body =~ /\s/g; my $letters = $body =~ tr/a-zA-Z//; # hehe - he said tr/// not y/// my $total = 10 * $whitespace + 3 * $letters + 1 * (length($contents) - $whitespace - $letters); my $fraction = length($contents) / $total; $fraction = 0.99 if $fraction > 0.99; return sprintf '%.2f', $golf + $fraction; } sub PrintGolfScore { my @scr = @_; my $tot = 0; for my $s (@scr) { my $g = GolfScore($s); print "$s: $g\n"; $tot += $g; } print "You shot a round of $tot strokes.\n"; } sub BuildFile { my ($fname, $data) = @_; local (*FF); open(FF, '>'.$fname) or die "error: open '$fname'"; print FF $data; close(FF); } my $testnumber = 1; sub CheckOneTsort { my ($data, $shouldfail) = @_; my $intmp = 'in.tmp'; my $errtmp = 'err.tmp'; BuildFile($intmp, $data); my $cmd = "$^X $script $intmp"; $cmd .= " 2>$errtmp" if $have_stderr_redirect; printf "%3d: running: '$cmd'...", $testnumber++; my $out = `$cmd`; my $rc = $? >> 8; print "done.\n"; if($shouldfail) { die "\nOops, you failed to exit with a non-zero exit code for case:\n$data" unless $rc; return 1; # it passed } else { die "\nOops, failed, you exited with a non-zero exit code $rc for case:\n$data" if $rc; } if ($have_stderr_redirect) { if(-s $errtmp) { open ERR, $errtmp or die "error $! opening $errtmp"; local $/; print ; close ERR; die "oops, you wrote to stderr (see $errtmp)\n"; } } else { warn "warning: cannot check you did not write to" . " stderr on this platform.\n"; } if (not ValidateTsort($data, $out)) { die "\nOops, you failed.\n"; } } # ----------------------------------------------------- sub ValidateTsort { my ($input, $output, %names, %positions, @positions) = @_; die "output has space or tab at end of line for case:\n$input" if $output =~ /[ \t]\n/; die "output is not formatted properly for case:\n$input" unless $output =~ /^([!-~]+\n)+\z/; @names{$input =~ /[!-~]+/g} = (); @positions = $output =~ /[!-~]+/g; @positions == keys %names or die "output has incorrect number of node names for case:\n$input"; "@{[sort keys %names]}" eq "@{[sort @positions]}" or die "output node names do not match input node names for case:\n$input"; @positions{@positions} = 1 .. @positions; while( $input =~ /([!-~]+)\s+([!-~]+)/g ) { $positions{$1} <= $positions{$2} or die "$1 is after $2 in output, should be before for case:\n$input"; } return 1; } sub CheckTsort { my ($scr) = @_; for my $r (@cases) { CheckOneTsort($r->[0], $r->[1]) } } # ----------------------------------------------------- select(STDERR);$|=1;select(STDOUT);$|=1; # auto-flush -f $script or die "error: file '$script' not found.\n"; PrintGolfScore($script); CheckTsort($script); PrintGolfScore($script); print "\nHooray, you PASSED.\n\n"; #use File::Slurp; #append_file 'run.log', "Score: @{[GolfScore()]} @{[ #scalar localtime]}\n\n$contents\n";