This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated Search-Dict to CPAN release 1.07
[perl5.git] / dist / Search-Dict / t / Dict.t
1 #!./perl
2
3 use strict;
4 use Test::More;
5 plan tests => ( $] ge '5.008' ? 14 : 10 );
6
7 my $DICT = <<EOT;
8 Aarhus
9 Aaron
10 Ababa
11 aback
12 abaft
13 abandon
14 abandoned
15 abandoning
16 abandonment
17 abandons
18 abase
19 abased
20 abasement
21 abasements
22 abases
23 abash
24 abashed
25 abashes
26 abashing
27 abasing
28 abate
29 abated
30 abatement
31 abatements
32 abater
33 abates
34 abating
35 Abba
36 EOT
37
38 use Tie::Handle; # loads Tie::StdHandle
39 use Search::Dict;
40
41 open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
42 binmode DICT;                   # To make length expected one.
43 print DICT $DICT;
44
45 my $word;
46
47 my $pos = look *DICT, "Ababa";
48 chomp($word = <DICT>);
49 cmp_ok $pos, ">=", 0;
50 is $word, "Ababa", "found 'Ababa' from file";
51
52 if (ord('a') > ord('A') ) {  # ASCII
53
54     $pos = look *DICT, "foo";
55     $word = <DICT>;
56
57     is $pos, length($DICT), "word not found will search to end of file";
58
59     my $pos = look *DICT, "abash";
60     chomp($word = <DICT>);
61     cmp_ok $pos, ">=", 0;
62     is $word, "abash";
63 }
64 else { # EBCDIC systems e.g. os390
65
66     $pos = look *DICT, "FOO";
67     $word = <DICT>;
68
69     is $pos, length($DICT);  # will search to end of file
70
71     my $pos = look *DICT, "Abba";
72     chomp($word = <DICT>);
73     cmp_ok $pos, ">=", 0;
74     is $word, "Abba";
75 }
76
77 $pos = look *DICT, "aarhus", 1, 1;
78 chomp($word = <DICT>);
79
80 cmp_ok $pos, ">=", 0;
81 is $word, "Aarhus";
82
83 close DICT or die "cannot close";
84
85 {
86   local $^W = 1; # turn on global warnings for stat() in Search::Dict
87
88   my $warn = '';
89   local $SIG{__WARN__} = sub { $warn = join("\n",@_) };
90
91   tie *DICT, 'Tie::StdHandle', "<", "dict-$$";
92
93   $pos = look \*DICT, "aarhus", 1, 1;
94   is( $warn, '', "no warning seen" );
95
96   $word = <DICT>;
97   chomp $word;
98
99   cmp_ok $pos, ">=", 0, "case-insensitive search for 'aarhus' returned > 0";
100   is $word, "Aarhus", "case-insensitive search found 'Aarhus'";
101
102 }
103 unlink "dict-$$";
104
105 if ( $] ge '5.008' ) {
106       open my $strfh, "<", \$DICT or die $!;
107
108       {
109           my $pos = look $strfh, 'Ababa';
110           chomp($word = <$strfh>);
111           cmp_ok $pos, ">=", 0;
112           is $word, "Ababa";
113       }
114
115       {
116           my $pos = look $strfh, "aarhus", 1, 1;
117           chomp($word = <$strfh>);
118           cmp_ok $pos, ">=", 0;
119           is $word, "Aarhus";
120       }
121
122       close $strfh;
123 }