More standard library test scripts
[perl.git] / 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