| 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 |