1#!/usr/bin/perl -w
2
3use strict;
4use lib './blib';
5use Lingua::Stem;
6
7my @do_tests=(1..3);
8
9my $test_subs = {
10       1 => { -code => \&test1, -desc => 'locale        ' },
11       2 => { -code => \&test2, -desc => 'stem          ' },
12       3 => { -code => \&test3, -desc => 'exceptions    ' },
13};
14print $do_tests[0],'..',$do_tests[$#do_tests],"\n";
15print STDERR "\n";
16my $n_failures = 0;
17foreach my $test (@do_tests) {
18	my $sub  = $test_subs->{$test}->{-code};
19	my $desc = $test_subs->{$test}->{-desc};
20	my $failure = '';
21	eval { $failure = &$sub; };
22	if ($@) {
23		$failure = $@;
24	}
25	if ($failure ne '') {
26		chomp $failure;
27		print "not ok $test\n";
28		print STDERR "    $desc - $failure\n";
29		$n_failures++;
30	} else {
31		print "ok $test\n";
32		print STDERR "    $desc - ok\n";
33
34	}
35}
36print "END\n";
37exit;
38
39########################################
40# Locale                               #
41########################################
42sub test1 {
43	my $stemmer = Lingua::Stem->new;
44	my $original_locale  = $stemmer->get_locale;
45
46	my @test_locales = ('En','En-Us','En-Uk', 'En-Broken');
47	my @errors = ();
48	foreach my $test_locale (@test_locales,$test_locales[0]) {
49		$stemmer->set_locale($test_locale);
50		my $new_locale  = $stemmer->get_locale;
51		if (lc($new_locale) ne lc($test_locale)) {
52			push (@errors,"unable to change locale to '$test_locale'");
53		}
54	}
55
56	# Restore original locale
57	$stemmer->set_locale($original_locale);
58	my $new_locale = $stemmer->get_locale;
59	if (lc($new_locale) ne lc($original_locale)) {
60		push (@errors,"unable to restore locale to '$original_locale'");
61	}
62	# Send the results back
63	join (', ',@errors);
64}
65
66########################################
67# Stem                                 #
68########################################
69sub test2 {
70	my $stemmer = Lingua::Stem->new;
71	my $original_locale  = $stemmer->get_locale;
72
73	my $test_locales = {
74	           'En' => {
75                  -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
76                 -expect => [qw(the lazi red dog quickli run over the gurgl brook)],
77				  },
78	        'En-Us' => {
79                  -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
80                 -expect => [qw(the lazi red dog quickli run over the gurgl brook)],
81				  },
82	        'En-Uk' => {
83                  -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
84                 -expect => [qw(the lazi red dog quickli run over the gurgl brook)],
85				  },
86	};
87	my @locales = sort keys %$test_locales;
88	my @errors  = ();
89	foreach my $locale_name (@locales) {
90		my $test_locale = $test_locales->{$locale_name};
91		$stemmer->set_locale($locale_name);
92		my $new_locale  = $stemmer->get_locale;
93		if (lc($new_locale) ne lc($locale_name)) {
94			push (@errors,"unable to change locale to '$locale_name'");
95		}
96		my $words  = $test_locale->{-words};
97		my $expect = $test_locale->{-expect};
98		my $stemmed = $stemmer->stem(@$words);
99		if ($#$stemmed != $#$expect) {
100			push (@errors,"different number of words returned than expected");
101		}
102		for (my $count=0;$count<=$#$stemmed;$count++) {
103			my $expected = $expect->[$count];
104			my $found    = $stemmed->[$count];
105			if ($found ne $expected) {
106				push (@errors,"expected '$expected', got '$found' for locale '$locale_name'");
107			}
108		}
109	}
110
111	# Restore original locale
112	$stemmer->set_locale($original_locale);
113	my $new_locale = $stemmer->get_locale;
114	if (lc($new_locale) ne lc($original_locale)) {
115		push(@errors, "unable to restore locale to '$original_locale'");
116	}
117	join(', ',@errors);
118}
119
120########################################
121# Exceptions                           #
122########################################
123sub test3 {
124	my $stemmer = Lingua::Stem->new;
125	my $original_locale  = $stemmer->get_locale;
126
127	my $test_locales = {
128                   'En' => {
129                      -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
130                     -expect => [qw(the lazi red cat quickli run over the gurgl brook)],
131                     -except => { 'dogs' => 'cat' },
132                      },
133                'En-Us' => {
134                      -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
135                     -expect => [qw(the lazi red dog quickli run over the gurgl stream)],
136                     -except => { 'brook' => 'stream' },
137                      },
138                'En-Uk' => {
139                      -words => [qw(The lazy red dogs quickly run over the gurgling brook)],
140                     -expect => [qw(the lazi akai dog quickli run over the gurgl brook)],
141                     -except => { 'red' => 'akai' },
142                      },
143				};
144	my @errors = ();
145	foreach my $locale_name (sort keys %$test_locales) {
146		my $test_locale = $test_locales->{$locale_name};
147		$stemmer->set_locale($locale_name);
148		my $new_locale  = $stemmer->get_locale;
149		if (lc($new_locale) ne lc($locale_name)) {
150			push(@errors,"unable to change locale to '$test_locale'");
151			next;
152		}
153		my $words  = $test_locale->{-words};
154		my $expect = $test_locale->{-expect};
155		my $except = $test_locale->{-except};
156		$stemmer->add_exceptions ($except);
157		my $exceptions = $stemmer->get_exceptions;
158		while (my ($key,$value) = each %$exceptions) {
159			if (not exists $except->{$key}) {
160				push (@errors,"exception '$key' => '$value' returned unexpectedly for locale '$locale_name'");
161			} elsif ($except->{$key} ne $value) {
162				push (@errors,"exception '$key' => '$value' returned unexpectedly for locale '$locale_name'");
163			}
164		}
165		while (my ($key,$value) = each %$except) {
166			if (not exists $exceptions->{$key}) {
167				push (@errors,"exception '$key' => '$value' not returned for locale '$locale_name'");
168			} elsif ($value ne $exceptions->{$key}) {
169				push (@errors,"exception '$key' => '$value' not returned for locale '$locale_name'");
170			}
171		}
172		my $stemmed = $stemmer->stem(@$words);
173		if ($#$stemmed != $#$expect) {
174			push(@errors, "different number of words returned than expected for locale '$locale_name'");
175		}
176		for (my $count=0;$count<=$#$stemmed;$count++) {
177			my $expected = $expect->[$count];
178			my $found    = $stemmed->[$count];
179			if ($found ne $expected) {
180				push (@errors,"expected '$expected', got '$found' for locale '$locale_name'");
181			}
182		}
183		$stemmer->delete_exceptions(keys %$exceptions);
184		$exceptions = $stemmer->get_exceptions;
185		my @e_list = keys %$exceptions;
186		if ($#e_list > -1) {
187			push (@errors,"failed to delete exceptions: ".join(' ',@e_list));
188		}
189	}
190
191	# Restore original locale
192	$stemmer->set_locale($original_locale);
193	my $new_locale = $stemmer->get_locale;
194	if (lc($new_locale) ne lc($original_locale)) {
195		push (@errors,"unable to restore locale to '$original_locale'");
196	}
197
198	# Send the results back
199	join (', ',@errors);
200}
201