1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
#!/usr/bin/perl -w
use strict;
use integer;
use Lingua::EN::NameCase qw( NameCase nc );
use Test::More tests => 31;
my $debugging = 0;
# Set up data for the tests.
my @proper_names = (
"Keith", "Leigh-Williams", "McCarthy",
"O'Callaghan", "St. John", "von Streit",
"van Dyke", "Van", "ap Llwyd Dafydd",
"al Fahd", "Al",
"el Grecco",
"Ben Gurion", "Ben",
"da Vinci",
"di Caprio", "du Pont", "de Legate",
"del Crond", "der Sind", "van der Post",
"von Trapp", "la Poisson", "le Figaro",
"Mack Knife", "Dougal MacDonald",
);
# Mac exceptions
my @mac_names = (
"Machin", "Machlin", "Machar",
"Mackle", "Macklin", "Mackie",
"Macquarie", "Machado", "Macevicius",
"Maciulis", "Macias", "MacMurdo",
"Mackrell", "Maclin", "McConnachie",
);
# Roman numerals
my @roman_names = (
"Henry VIII", "Louis III", "Louis XIV",
"Charles II", "Fred XLIX",
);
push @proper_names, @mac_names, @roman_names;
# Set up some module globals.
my @lowercase_names = map { lc } @proper_names;
my @names = @lowercase_names;
my @result;
my $name;
my $fixed_name;
$" = ", " ; #"
# Print the original.
diag("\tOriginal:\n@lowercase_names.\n") if $debugging;
# Test an array without changing the array's contents; print the first result.
@result = NameCase( @names );
diag("\tResult:\n@result.\n") if $debugging;
diag("\nArray assignment with source array passed by copy...") if $debugging;
is_deeply( \@names, \@lowercase_names, 'Array assignment with source array passed by copy' );
is_deeply( \@result, \@proper_names, '.. fixed' );
# Test an array without changing the array's contents;
# but pass the array by reference.
@result = ();
@result = NameCase( \@names );
is_deeply( \@names, \@lowercase_names, 'Array assignment with source array passed by reference' );
is_deeply( \@result, \@proper_names, '.. fixed' );
# Test an array in-place.
NameCase( \@names );
is_deeply( \@names, \@proper_names, 'In-place with source array passed by reference' );
# Test a scalar in-place.
$name = $lowercase_names[1];
NameCase( \$name );
is( $name, $lowercase_names[1], 'In-place scalar (null operation)' );
# Test a scalar.
$name = $lowercase_names[1];
$fixed_name = NameCase( $name );
is( $fixed_name, $proper_names[1], 'Scalar...' );
# Test a literal scalar.
$fixed_name = NameCase( "john mcvey" );
is( $fixed_name, "John McVey", 'Literal scalar...' );
# Test a literal array.
@result = NameCase( "nancy", "drew" );
is_deeply( \@result, [ "Nancy", "Drew" ], 'Literal array...' );
# Test a scalar.
$name = $lowercase_names[1];
$fixed_name = nc $name;
is( $fixed_name, $proper_names[1], 'Scalar as list operator...' );
# Test a literal scalar.
$fixed_name = nc "john mcvey";
is( $fixed_name, "John McVey", 'Literal scalar as list operator...' );
# Test a reference to a scalar.
$name = $lowercase_names[1];
$fixed_name = nc( \$name );
is( $name, $lowercase_names[1],'Reference to a scalar using nc...' );
is( $fixed_name, $proper_names[1],'.. fixed' );
# Test a scalar in an array context.
$name = $lowercase_names[1];
@result = nc $name;
is( $result[0], $proper_names[1], 'Scalar in a list context using nc...');
# Test a reference to a scalar in an array context.
$name = $lowercase_names[1];
@result = nc \$name;
print "Reference to a scalar in a list context using nc..."
if $debugging;
print "" . ( $name eq $lowercase_names[1] ? "ok" : "not ok\a" )
if $debugging;
is( $name, $lowercase_names[1], 'Reference to a scalar in a list context using nc...');
is( $result[0], $proper_names[1], '.. fixed');
# Test a reference to a scalar.
$name = $lowercase_names[1];
$fixed_name = NameCase( \$name );
is( $name, $lowercase_names[1], 'Reference to a scalar using NameCase...' );
is( $fixed_name, $proper_names[1], '.. fixed' );
# Test a scalar in an array context.
$name = $lowercase_names[1];
@result = NameCase $name;
is( $result[0], $proper_names[1], 'Scalar in a list context using NameCase...' );
# Test a reference to a scalar in an array context.
$name = $lowercase_names[1];
@result = NameCase \$name;
is( $name, $lowercase_names[1], 'Reference to a scalar in a list context using NameCase...' );
is( $result[0], $proper_names[1], '.. fixed');
$Lingua::EN::NameCase::SPANISH = 1;
is( nc( 'El Paso' ), 'El Paso', 'spanish' );
is( nc( 'La Luna' ), 'La Luna', 'spanish' );
$Lingua::EN::NameCase::SPANISH = 0;
is( nc( 'El Paso' ), 'el Paso', 'not spanish' );
is( nc( 'La Luna' ), 'la Luna', 'not spanish' );
$Lingua::EN::NameCase::ROMAN = 1;
is( nc( 'Na Li' ), 'Na LI', 'roman numerals' );
$Lingua::EN::NameCase::ROMAN = 0;
is( nc( 'Na Li' ), 'Na Li', 'not roman numerals' );
$Lingua::EN::NameCase::POSTNOMINAL = 1;
is( nc( 'Barbie PHD' ), 'Barbie PhD', 'post nominal initials' );
$Lingua::EN::NameCase::POSTNOMINAL = 0;
is( nc( 'Barbie PHD' ), 'Barbie Phd', 'not post nominal initials' );
$Lingua::EN::NameCase::HEBREW = 1;
is( nc( 'Aharon BEN Amram Ha-Kohein' ), 'Aharon ben Amram Ha-Kohein', 'hebrew' );
$Lingua::EN::NameCase::HEBREW = 0;
is( nc( 'Aharon BEN Amram Ha-Kohein' ), 'Aharon Ben Amram Ha-Kohein', 'not hebrew' );
|
