Commit | Line | Data |
---|---|---|
1a3850a5 GA |
1 | #!./perl |
2 | ||
0b0a7092 CBW |
3 | use strict; |
4 | use Test::More; | |
5 | plan tests => ( $] ge '5.008' ? 14 : 10 ); | |
1a3850a5 | 6 | |
0b0a7092 | 7 | my $DICT = <<EOT; |
1a3850a5 GA |
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 | ||
0b0a7092 | 38 | use Tie::Handle; # loads Tie::StdHandle |
1a3850a5 GA |
39 | use Search::Dict; |
40 | ||
41 | open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!"; | |
55497cff | 42 | binmode DICT; # To make length expected one. |
1a3850a5 GA |
43 | print DICT $DICT; |
44 | ||
0b0a7092 CBW |
45 | my $word; |
46 | ||
4beedc23 | 47 | my $pos = look *DICT, "Ababa"; |
1a3850a5 | 48 | chomp($word = <DICT>); |
0b0a7092 CBW |
49 | cmp_ok $pos, ">=", 0; |
50 | is $word, "Ababa", "found 'Ababa' from file"; | |
1a3850a5 | 51 | |
4beedc23 PP |
52 | if (ord('a') > ord('A') ) { # ASCII |
53 | ||
54 | $pos = look *DICT, "foo"; | |
0b0a7092 | 55 | $word = <DICT>; |
4beedc23 | 56 | |
0b0a7092 | 57 | is $pos, length($DICT), "word not found will search to end of file"; |
1a3850a5 | 58 | |
4beedc23 PP |
59 | my $pos = look *DICT, "abash"; |
60 | chomp($word = <DICT>); | |
0b0a7092 CBW |
61 | cmp_ok $pos, ">=", 0; |
62 | is $word, "abash"; | |
4beedc23 PP |
63 | } |
64 | else { # EBCDIC systems e.g. os390 | |
65 | ||
66 | $pos = look *DICT, "FOO"; | |
0b0a7092 | 67 | $word = <DICT>; |
4beedc23 | 68 | |
0b0a7092 | 69 | is $pos, length($DICT); # will search to end of file |
4beedc23 PP |
70 | |
71 | my $pos = look *DICT, "Abba"; | |
72 | chomp($word = <DICT>); | |
0b0a7092 CBW |
73 | cmp_ok $pos, ">=", 0; |
74 | is $word, "Abba"; | |
4beedc23 | 75 | } |
1a3850a5 GA |
76 | |
77 | $pos = look *DICT, "aarhus", 1, 1; | |
78 | chomp($word = <DICT>); | |
79 | ||
0b0a7092 CBW |
80 | cmp_ok $pos, ">=", 0; |
81 | is $word, "Aarhus"; | |
55497cff | 82 | |
83 | close DICT or die "cannot close"; | |
0b0a7092 CBW |
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 | ||
43c6d004 | 102 | untie *DICT; |
0b0a7092 | 103 | } |
55497cff | 104 | unlink "dict-$$"; |
0b0a7092 CBW |
105 | |
106 | if ( $] ge '5.008' ) { | |
107 | open my $strfh, "<", \$DICT or die $!; | |
108 | ||
109 | { | |
110 | my $pos = look $strfh, 'Ababa'; | |
111 | chomp($word = <$strfh>); | |
112 | cmp_ok $pos, ">=", 0; | |
113 | is $word, "Ababa"; | |
114 | } | |
115 | ||
116 | { | |
117 | my $pos = look $strfh, "aarhus", 1, 1; | |
118 | chomp($word = <$strfh>); | |
119 | cmp_ok $pos, ">=", 0; | |
120 | is $word, "Aarhus"; | |
121 | } | |
122 | ||
123 | close $strfh; | |
124 | } |