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 19BEGIN { 20 chdir 't' if -d 't'; 21 @INC = '../lib'; 22} 23 24use Text::Soundex; 25 26$test = 0; 27print "1..13\n"; 28 29while (<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 117undef: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# 135eval $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# 143CZARKOWSKA:C622 144