=========================
New test program teven.pl
=========================
Please find new test program, teven.pl, embedded below.
Minor bug fixes:

1)  Win95/98 now prints expected number making it easier
    to manually check gs.pl (thanks Tim Gim Yee).

2)  gs.pl test data: Changed 'Great' to 'Great?' to break an
    unsound entry (thanks Jas). I know, I should test more
    cases, too lazy.

3)  even.pl test data: Added test case for word 'st' with
    no vowels (thanks Sven). This should match since it
    contains an even number (0) of all vowels.

4)  even.pl test data: Added some bizarre test data to break
    one of Keith's more imaginative solutions. :)
    Keith called this one on himself and kindly provided
    me with the test data.

Please recheck your solutions with the new test program.
The top three golfers all pass the new test program.
In fact, I think all do, but just recheck to be sure,
to be sure.

If you suspect your solution is unsound, please please do what
Keith did, and try to find some test data that breaks it.
At the end of the game, the other players have the right to
find test data that breaks any solution and that solution will
then be disqualified, so it is much better to find that out now.
I hope to get more time over the weekend to study the leading
solutions more closely for correctness.

/-\ndrew


# teven.pl. Get even golf game test program (2nd version).

use strict;

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 $script = shift;
   local ($_, *FF);
   open(FF, $script) or die "could not open $script: $!";
   my $golf = -1;     # your free last newline
   while (<FF>) {
       s/\n?$/\n/;
       $golf-- if $. == 1 && s/^#!.*?perl//;
       $golf += length;
   }
   close(FF);
   return $golf;
}

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);
}

sub CheckOne {
   my ($scr, $label, $data, $exp) = @_;
   my $intmp  = 'in.tmp';
   my $errtmp = 'err.tmp';
   BuildFile($intmp, $data);
   my $cmd = "$^X $scr $intmp";
   $cmd .= " 2>$errtmp" if $have_stderr_redirect;
   print "$label: running: '$cmd'...";
   my $out = `$cmd`; my $rc = $? >> 8;
   print "done.\n";
   if ($have_stderr_redirect) {
      -s $errtmp and
         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 ($out ne $exp) {
      warn "Expected:\n"; print STDERR $exp;
      warn "Got:\n"; print STDERR $out;
      die "\nOops, you failed.\n";
   }
}

sub CheckOneGs {
   my ($scr, $label, $data, $expout, $experr) = @_;
   my $intmp  = 'in.tmp';
   my $errtmp = 'err.tmp';
   BuildFile($intmp, $data);
   my $cmd = "$^X $scr $intmp";
   $cmd .= " 2>$errtmp" if $have_stderr_redirect;
   print "$label: running: '$cmd'...";
   my $out = `$cmd`; my $rc = $? >> 8;
   print "done.\n";
   if ($have_stderr_redirect) {
      -s $errtmp or die "oops, you did not write to stderr\n";
      local (*FF);
      local $/ = undef;
      open(FF, $errtmp) or die "error: open $errtmp: $!";
      my $err = <FF>;
      close(FF);
      my $num_nl = $err =~ tr/\n//;
      $num_nl == 1 or
         die "error: stderr has $num_nl newlines (not 1)" .
             ", see $errtmp\n";
      chop($err);
      $err =~ /\D/ and
         die "error: stderr has non-numerics, see $errtmp\n";
      if ($err != $experr) {
         print STDERR "stderr Expected:"; print STDERR $experr;
         print STDERR " Got:"; print STDERR $err;
         die "\nOops, you failed.\n";
      }
   } else {
      warn "warning: cannot check you wrote byte count to" .
           " stderr on this platform [$experr].\n";
   }
   if ($out ne $expout) {
      warn "stdout Expected:\n"; print STDERR $expout;
      warn " Got:\n"; print STDERR $out;
      die "\nOops, you failed.\n";
   }
}

# -----------------------------------------------------

my $words1 = <<'GROK';
a
abbreviate
abbatestaaaaxuzuzcycyxeexeiiiigogo
abbatestaaaaxuzuzcycyxeexeiiiigogo
aerate
abbatestaaaaxuzuzcycyxeexeiiiigogz
abbatestaaaaxuzuzcycyxeexeiiiigogz
abbatestaaaaxuzuzcycyxeexeiiigogoz
abbatestaaaaxuzuzcycyxeexeiiigogoz
abbatestaaaaxuzuzcycyxeexiiiigogoz
abbatestaaaaxuzuzcycyxeexiiiigogoz
abbatestaaaaxuzuzcycxeexeiiiigogoz
abbatestaaaaxuzuzcycxeexeiiiigogoz
abbatestaaaaxuzzcycyxeexeiiiigogoz
abbatestaaaaxuzzcycyxeexeiiiigogoz
abbatestaaaxuzuzcycyxeexeiiiigogoz
abbatestaaaxuzuzcycyxeexeiiiigogoz
aghast
anal
antidisestablishmentarianism
appeased
arrays
artificialities
autrijus
averaged
avocados
bactrian
backhand
be
bleach
buffy
camel
capitalist
cat
damian
dereference
dipsy
dissimilarities
divisibility
doctor
dromedary
ee
ee
eugene
eighties
fanaticism
fee
feel
fungus
golf
golfer
heterogeneousness
impossibilities
inadmissibility
incompatibilities
incontrovertible
individualistic
individualize
indivisibility
inevitabilities
initialization
initializing
institutionalizing
intelligibility
interdependence
interdependencies
invisibility
italic
italicize
iterate
japh
kangaroo
karsten
larry
meekly
merlyn
monger
obsolete
octal
odious
office
piers
pony
representativeness
riding
santa
spiff
undo
unjustly
unlucky
unusable
upload
usage
wretches
ww
GROK

my $words2 = <<'GROK';
aaa
jjjaaaeeeiiiooouuuyyy
aab
aeiouyybbcd
aaa
jjaaaeeeiiiooouuuyyy
aab
aeiouyybcd
abbreviate
aficionado
blames
booboo
booty
chipmunk
circuit
chock
crosswords
flagellate
inkling
pipeline
sven
st
keith
impudently
keith
zazezizozuzy
keith
zezizuzy
zaa
zzaaaaei
zaa
zzaaaaeo
zaa
zzaaaaeu
zaa
zzaaaaey
zaa
zzaaaaio
zaa
zzaaaaiu
zaa
zzaaaaiy
zaa
zzaaaaou
zaa
zzaaaaoy
zaa
zzaaaauy
zee
zzeeeeai
zee
zzeeeeao
zee
zzeeeeau
zee
zzeeeeay
zee
zzeeeeio
zee
zzeeeeiu
zee
zzeeeeiy
zee
zzeeeeou
zee
zzeeeeuy
zee
zzeeeeiy
zii
zziiiiae
zii
zziiiiao
zii
zziiiiau
zii
zziiiiay
zii
zziiiieo
zii
zziiiieu
zii
zziiiiey
zii
zziiiiou
zii
zziiiioy
zii
zziiiiuy
zoo
zzooooae
zoo
zzooooai
zoo
zzooooao
zoo
zzooooau
zoo
zzooooay
zoo
zzooooeo
zoo
zzooooeu
zoo
zzooooey
zoo
zzooooiu
zoo
zzoooouy
zuu
zzuuuuae
zuu
zzuuuuai
zuu
zzuuuuao
zuu
zzuuuuau
zuu
zzuuuuay
zuu
zzuuuuei
zuu
zzuuuueo
zuu
zzuuuuey
zuu
zzuuuuio
zuu
zzuuuuiy
zyy
zzyyyyae
zyy
zzyyyyai
zyy
zzyyyyao
zyy
zzyyyyau
zyy
zzyyyyei
zyy
zzyyyyeo
zyy
zzyyyyeu
zyy
zzyyyyio
zyy
zzyyyyiu
zyy
zzyyyyou
zzz
zaechy
zzz
zaichy
zzz
zaochy
zzz
zauchy
zzz
zeichy
zzz
zeochy
zzz
zeuchy
zzz
ziochy
zzz
ziuchy
zzz
zouchy
GROK

my $words3 = <<'GROK';
aficionado
blames
booboo
GROK


# -----------------------------------------------------

my $gs0 = <<'GROK';
hello
GROK

my $gs0a = $gs0; chop($gs0a);
my $gs0exp = 'hello';

my $gs1 = <<'GROK';
aficionado
blames
booboo


GROK

my $gs1a = $gs1; chop($gs1a);
my $gs1exp = 'aficionadoblamesbooboo';

my $gs2 = <<'GROK';


 Buffy  is like
Catherine the

Great?



GROK

my $gs2a = $gs2; chop($gs2a);
my $gs2exp = ' Buffy  is likeCatherine theGreat?';

my $gs3 = <<'GROK';



GROK

my $gs3exp = '';

# -----------------------------------------------------

sub CheckEven {
   my ($scr) = @_;
   my @tt = (
       [ 'words1',  $words1, "abbatestaaaaxuzuzcycyxeexeiiiigogo\n".
                             "aghast\n".
                             "avocados\n".
                             "backhand\n".
                             "doctor\n".
                             "ee\n".
                             "fanaticism\n".
                             "feel\n".
                             "incontrovertible\n".
                             "kangaroo\n".
                             "obsolete\n".
                             "wretches\n" ],
       [ 'words2',  $words2, "aficionado\n".
                             "booboo\n".
                             "flagellate\n".
                             "pipeline\n".
                             "st\n" ],
       [ 'words3',  $words3, "" ],
   );
   for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}


sub CheckGs {
   my ($scr) = @_;
   my @tt = (
       [ 'gs0',  $gs0,  $gs0exp, length($gs0exp) ],
       [ 'gs0a', $gs0a, $gs0exp, length($gs0exp) ],
       [ 'gs1',  $gs1,  $gs1exp, length($gs1exp) ],
       [ 'gs1a', $gs1a, $gs1exp, length($gs1exp) ],
       [ 'gs2',  $gs2,  $gs2exp, length($gs2exp) ],
       [ 'gs2a', $gs2a, $gs2exp, length($gs2exp) ],
       [ 'gs3',  $gs3,  $gs3exp, length($gs3exp) ],
   );
   for my $r (@tt) {
      CheckOneGs($scr, $r->[0], $r->[1], $r->[2], $r->[3]);
   }
}

# -----------------------------------------------------

my $even = 'even.pl';
my $gs = 'gs.pl';
select(STDERR);$|=1;select(STDOUT);$|=1;  # auto-flush
-f $even or die "error: file '$even' not found.\n";
-f $gs or die "error: file '$gs' not found.\n";
PrintGolfScore($even, $gs);
CheckEven($even);
CheckGs($gs);
PrintGolfScore($even, $gs);
print "Hooray, you passed.\n";

Reply via email to