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