contrib/perl5/t/lib/soundex.t

   1 #!./perl
   2 #
   3 # $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
   4 #
   5 # test module for soundex.pl
   6 #
   7 # $Log: soundex.t,v $
   8 # Revision 1.2  1994/03/24  00:30:27  mike
   9 # Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
  10 # in the way I handles leasing characters which were different but had
  11 # the same soundex code.  This showed up comparing it with Oracle's
  12 # soundex output.
  13 #
  14 # Revision 1.1  1994/03/02  13:03:02  mike
  15 # Initial revision
  16 #
  17 #
  18
  19 BEGIN {
  20     chdir 't' if -d 't';
  21     @INC = '../lib';
  22 }
  23
  24 use Text::Soundex;
  25
  26 $test = 0;
  27 print "1..13\n";
  28
  29 while (<DATA>)
  30 {
  31   chop;
  32   next if /^\s*;?#/;
  33   next if /^\s*$/;
  34
  35   ++$test;
  36   $bad = 0;
  37
  38   if (/^eval\s+/)
  39   {
  40     ($try = $_) =~ s/^eval\s+//;
  41
  42     eval ($try);
  43     if ($@)
  44     {
  45       $bad++;
  46       print "not ok $test\n";
  47       print "# eval '$try' returned $@";
  48     }
  49   }
  50   elsif (/^\(/)
  51   {
  52     ($in, $out) = split (':');
  53
  54     $try = "\@expect = $out; \@got = &soundex $in;";
  55     eval ($try);
  56
  57     if (@expect != @got)
  58     {
  59       $bad++;
  60       print "not ok $test\n";
  61       print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
  62       print "# expected (", join (', ', @expect),
  63             ") got (", join (', ', @got), ")\n";
  64     }
  65     else
  66     {
  67       while (@got)
  68       {
  69         $expect = shift @expect;
  70         $got = shift @got;
  71
  72         if ($expect ne $got)
  73         {
  74           $bad++;
  75           print "not ok $test\n";
  76           print "# expected $expect, got $got\n";
  77         }
  78       }
  79     }
  80   }
  81   else
  82   {
  83     ($in, $out) = split (':');
  84
  85     $try = "\$expect = $out; \$got = &soundex ($in);";
  86     eval ($try);
  87
  88     if ($expect ne $got)
  89     {
  90       $bad++;
  91       print "not ok $test\n";
  92       print "# expected $expect, got $got\n";
  93     }
  94   }
  95
  96   print "ok $test\n" unless $bad;
  97 }
  98
  99 __END__
 100 #
 101 # 1..6
 102 #
 103 # Knuth's test cases, scalar in, scalar out
 104 #
 105 'Euler':'E460'
 106 'Gauss':'G200'
 107 'Hilbert':'H416'
 108 'Knuth':'K530'
 109 'Lloyd':'L300'
 110 'Lukasiewicz':'L222'
 111 #
 112 # 7..8
 113 #
 114 # check default bad code
 115 #
 116 '2 + 2 = 4':undef
 117 undef:undef
 118 #
 119 # 9
 120 #
 121 # check array in, array out
 122 #
 123 ('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
 124 #
 125 # 10
 126 #
 127 # check array with explicit undef
 128 #
 129 ('Mike', undef, 'Stok'):('M200', undef, 'S320')
 130 #
 131 # 11..12
 132 #
 133 # check setting $Text::Soundex::noCode
 134 #
 135 eval $soundex_nocode = 'Z000';
 136 ('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
 137 #
 138 # 13
 139 #
 140 # a subtle difference between me & oracle, spotted by Rich Pinder
 141 # <rpinder@hsc.usc.edu>
 142 #
 143 CZARKOWSKA:C622