BEGIN {
sub
t (&);
sub
tsoundex;
sub
test_label;
}
t {
test_label
"use Text::Soundex qw(:Default-Ruleset)"
;
eval
"use Text::Soundex qw(:Default-Ruleset)"
;
die
if
$@;
};
t {
test_label
"use Text::Soundex qw(:NARA-Ruleset)"
;
eval
"use Text::Soundex qw(:NARA-Ruleset)"
;
die
if
$@;
};
t {
test_label
"use Text::Soundex qw(soundex_nara)"
;
eval
"use Text::Soundex qw(soundex_nara)"
;
die
if
$@;
};
tsoundex(
"Euler"
=>
"E460"
);
tsoundex(
"Gauss"
=>
"G200"
);
tsoundex(
"Hilbert"
=>
"H416"
);
tsoundex(
"Knuth"
=>
"K530"
);
tsoundex(
"Lloydi"
=>
"L300"
);
tsoundex(
"Lukasiewicz"
=>
"L222"
);
tsoundex(
"2 + 2 = 4"
=>
undef
);
tsoundex(
undef
() =>
undef
);
tsoundex([
qw/Ellery Ghosh Heilbronn Kant Ladd Lissajous/
],
[
qw/E460 G200 H416 K530 L300 L222 /
]);
tsoundex([
'Mark'
,
'Mielke'
],
[
'M620'
,
'M420'
]);
tsoundex([
'Mike'
,
undef
,
'Stok'
],
[
'M200'
,
undef
,
'S320'
]);
{
my
$nocodeValue
=
'Z000'
;
$soundex_nocode
=
$nocodeValue
;
t {
test_label
"setting \$soundex_nocode"
;
die
if
soundex(
undef
) ne
$nocodeValue
;
};
t {
test_label
"\$soundex_nocode eq \$Text::Soundex::nocode"
;
die
if
$Text::Soundex::nocode
ne
$soundex_nocode
;
};
}
t {
test_label
"empty list"
;
die
if
defined
(soundex());
};
tsoundex(
"CZARKOWSKA"
=>
"C622"
);
exit
0;
my
$test_label
;
sub
t (&)
{
my
(
$test_f
) =
@_
;
$test_label
=
undef
;
eval
{
&$test_f
};
my
$success
= $@ ?
"failed"
:
"ok"
;
print
$test_label
,
'.'
x (60 - (
length
(
$test_label
) % 80)),
$success
,
"\n"
;
}
sub
tsoundex
{
my
(
$string
,
$expected
) =
@_
;
if
(
ref
(
$string
) eq
'ARRAY'
) {
t {
my
$s
= scalar2string(
@$string
);
my
$e
= scalar2string(
@$expected
);
$test_label
=
"soundex($s) eq ($e)"
;
my
@codes
= soundex(
@$string
);
for
(
$i
= 0;
$i
<
@$string
;
$i
++) {
my
$success
= !(
defined
(
$codes
[
$i
])||
defined
(
$expected
->[
$i
]));
if
(
defined
(
$codes
[
$i
]) &&
defined
(
$expected
->[
$i
])) {
$success
= (
$codes
[
$i
] eq
$expected
->[
$i
]);
}
die
if
!
$success
;
}
};
}
else
{
t {
my
$s
= scalar2string(
$string
);
my
$e
= scalar2string(
$expected
);
$test_label
=
"soundex($s) eq $e"
;
my
$code
= soundex(
$string
);
my
$success
= !(
defined
(
$code
) ||
defined
(
$expected
));
if
(
defined
(
$code
) &&
defined
(
$expected
)) {
$success
= (
$code
eq
$expected
);
}
die
if
!
$success
;
};
}
}
sub
test_label
{
$test_label
=
$_
[0];
}
sub
scalar2string
{
join
(
", "
,
map
{
defined
(
$_
) ?
qq{'$_'}
:
qq{undef}
}
@_
);
}