1use strict;
2
3my $test_counter;
4
5BEGIN {
6    $test_counter = 0;
7    sub t (&);
8    sub tsoundex;
9    sub test_label;
10}
11
12END {
13    print "1..$test_counter\n";
14}
15
16t {
17    test_label "use Text::Soundex 'soundex'";
18    eval "use Text::Soundex 'soundex'";
19    die if $@;
20};
21
22t {
23    test_label "use Text::Soundex 'soundex_nara'";
24    eval "use Text::Soundex 'soundex_nara'";
25    die if $@;
26};
27
28t {
29    test_label "use Text::Soundex;";
30    eval "use Text::Soundex";
31    die if $@;
32};
33
34# Knuth's test cases, scalar in, scalar out
35tsoundex("Euler"       => "E460");
36tsoundex("Gauss"       => "G200");
37tsoundex("Hilbert"     => "H416");
38tsoundex("Knuth"       => "K530");
39tsoundex("Lloydi"      => "L300");
40tsoundex("Lukasiewicz" => "L222");
41
42# check default "no code" code on a bad string and undef
43tsoundex("2 + 2 = 4"   => undef);
44tsoundex(undef()       => undef);
45
46# check list context with and without "no code"
47tsoundex([qw/Ellery Ghosh Heilbronn Kant Ladd Lissajous/],
48	 [qw/E460   G200  H416      K530 L300 L222     /]);
49tsoundex(['Mark', 'Mielke'],
50	 ['M620', 'M420']);
51tsoundex(['Mike', undef, 'Stok'],
52	 ['M200', undef, 'S320']);
53
54# check the deprecated $soundex_nocode and make sure it's reflected in
55# the $Text::Soundex::nocode variable.
56{
57    our $soundex_nocode;
58    my $nocodeValue = 'Z000';
59    $soundex_nocode = $nocodeValue;
60
61    t {
62	test_label "setting \$soundex_nocode";
63	die if soundex(undef) ne $nocodeValue;
64    };
65
66    t {
67	test_label "\$soundex_nocode eq \$Text::Soundex::nocode";
68	die if $Text::Soundex::nocode ne $soundex_nocode;
69    };
70}
71
72# make sure an empty argument list returns an undefined scalar
73t {
74    test_label "empty list";
75    die if defined(soundex());
76};
77
78# test to detect an error in Mike Stok's original implementation, the
79# error isn't in Mark Mielke's at all but the test should be kept anyway.
80# originally spotted by Rich Pinder <rpinder@hsc.usc.edu>
81tsoundex("CZARKOWSKA" => "C622");
82
83exit 0;
84
85
86my $test_label;
87
88sub t (&)
89{
90    my($test_f) = @_;
91    $test_label = undef;
92    eval {&$test_f};
93    my $ok = $@ ? "not ok" : "ok";
94    $test_counter++;
95    print "$ok - $test_counter $test_label\n";
96}
97
98sub tsoundex
99{
100    my($string, $expected) = @_;
101    if (ref($string) eq 'ARRAY') {
102	t {
103            my $s = scalar2string(@$string);
104            my $e = scalar2string(@$expected);
105	    $test_label = "soundex($s) eq ($e)";
106	    my @codes = soundex(@$string);
107	    for (my $i = 0; $i < @$string; $i++) {
108		my $success = !(defined($codes[$i])||defined($expected->[$i]));
109		if (defined($codes[$i]) && defined($expected->[$i])) {
110		    $success = ($codes[$i] eq $expected->[$i]);
111		}
112		die if !$success;
113	    }
114	};
115    } else {
116	t {
117	    my $s = scalar2string($string);
118	    my $e = scalar2string($expected);
119	    $test_label = "soundex($s) eq $e";
120	    my $code = soundex($string);
121	    my $success = !(defined($code) || defined($expected));
122	    if (defined($code) && defined($expected)) {
123		$success = ($code eq $expected);
124	    }
125	    die if !$success;
126	};
127    }
128}
129
130sub test_label
131{
132    $test_label = $_[0];
133}
134
135sub scalar2string
136{
137    join(", ", map {defined($_) ? qq{'$_'} : qq{undef}} @_);
138}
139