home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / soundex.t < prev    next >
Text File  |  1999-07-20  |  2KB  |  144 lines
  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.     unshift @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
  144.