1N/A#!./perl
1N/A#
1N/A# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
1N/A#
1N/A# test module for soundex.pl
1N/A#
1N/A# $Log: soundex.t,v $
1N/A# Revision 1.2 1994/03/24 00:30:27 mike
1N/A# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
1N/A# in the way I handles leasing characters which were different but had
1N/A# the same soundex code. This showed up comparing it with Oracle's
1N/A# soundex output.
1N/A#
1N/A# Revision 1.1 1994/03/02 13:03:02 mike
1N/A# Initial revision
1N/A#
1N/A#
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Ause Text::Soundex;
1N/A
1N/A$test = 0;
1N/Aprint "1..13\n";
1N/A
1N/Awhile (<DATA>)
1N/A{
1N/A chop;
1N/A next if /^\s*;?#/;
1N/A next if /^\s*$/;
1N/A
1N/A ++$test;
1N/A $bad = 0;
1N/A
1N/A if (/^eval\s+/)
1N/A {
1N/A ($try = $_) =~ s/^eval\s+//;
1N/A
1N/A eval ($try);
1N/A if ($@)
1N/A {
1N/A $bad++;
1N/A print "not ok $test\n";
1N/A print "# eval '$try' returned $@";
1N/A }
1N/A }
1N/A elsif (/^\(/)
1N/A {
1N/A ($in, $out) = split (':');
1N/A
1N/A $try = "\@expect = $out; \@got = &soundex $in;";
1N/A eval ($try);
1N/A
1N/A if (@expect != @got)
1N/A {
1N/A $bad++;
1N/A print "not ok $test\n";
1N/A print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
1N/A print "# expected (", join (', ', @expect),
1N/A ") got (", join (', ', @got), ")\n";
1N/A }
1N/A else
1N/A {
1N/A while (@got)
1N/A {
1N/A $expect = shift @expect;
1N/A $got = shift @got;
1N/A
1N/A if ($expect ne $got)
1N/A {
1N/A $bad++;
1N/A print "not ok $test\n";
1N/A print "# expected $expect, got $got\n";
1N/A }
1N/A }
1N/A }
1N/A }
1N/A else
1N/A {
1N/A ($in, $out) = split (':');
1N/A
1N/A $try = "\$expect = $out; \$got = &soundex ($in);";
1N/A eval ($try);
1N/A
1N/A if ($expect ne $got)
1N/A {
1N/A $bad++;
1N/A print "not ok $test\n";
1N/A print "# expected $expect, got $got\n";
1N/A }
1N/A }
1N/A
1N/A print "ok $test\n" unless $bad;
1N/A}
1N/A
1N/A__END__
1N/A#
1N/A# 1..6
1N/A#
1N/A# Knuth's test cases, scalar in, scalar out
1N/A#
1N/A'Euler':'E460'
1N/A'Gauss':'G200'
1N/A'Hilbert':'H416'
1N/A'Knuth':'K530'
1N/A'Lloyd':'L300'
1N/A'Lukasiewicz':'L222'
1N/A#
1N/A# 7..8
1N/A#
1N/A# check default bad code
1N/A#
1N/A'2 + 2 = 4':undef
1N/Aundef:undef
1N/A#
1N/A# 9
1N/A#
1N/A# check array in, array out
1N/A#
1N/A('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
1N/A#
1N/A# 10
1N/A#
1N/A# check array with explicit undef
1N/A#
1N/A('Mike', undef, 'Stok'):('M200', undef, 'S320')
1N/A#
1N/A# 11..12
1N/A#
1N/A# check setting $Text::Soundex::noCode
1N/A#
1N/Aeval $soundex_nocode = 'Z000';
1N/A('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
1N/A#
1N/A# 13
1N/A#
1N/A# a subtle difference between me & oracle, spotted by Rich Pinder
1N/A# <rpinder@hsc.usc.edu>
1N/A#
1N/ACZARKOWSKA:C622