RE: Untested libraries update
[p5sagit/p5-mst-13.2.git] / lib / Text / Soundex.t
CommitLineData
a0d0e21e 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';
20822f61 21 @INC = '../lib';
a0d0e21e 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