This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/uni/overload.t: test for RT #3270
[perl5.git] / dist / Search-Dict / t / Dict.t
CommitLineData
1a3850a5
GA
1#!./perl
2
0b0a7092
CBW
3use strict;
4use Test::More;
5plan tests => ( $] ge '5.008' ? 14 : 10 );
1a3850a5 6
0b0a7092 7my $DICT = <<EOT;
1a3850a5
GA
8Aarhus
9Aaron
10Ababa
11aback
12abaft
13abandon
14abandoned
15abandoning
16abandonment
17abandons
18abase
19abased
20abasement
21abasements
22abases
23abash
24abashed
25abashes
26abashing
27abasing
28abate
29abated
30abatement
31abatements
32abater
33abates
34abating
35Abba
36EOT
37
0b0a7092 38use Tie::Handle; # loads Tie::StdHandle
1a3850a5
GA
39use Search::Dict;
40
41open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
55497cff 42binmode DICT; # To make length expected one.
1a3850a5
GA
43print DICT $DICT;
44
0b0a7092
CBW
45my $word;
46
4beedc23 47my $pos = look *DICT, "Ababa";
1a3850a5 48chomp($word = <DICT>);
0b0a7092
CBW
49cmp_ok $pos, ">=", 0;
50is $word, "Ababa", "found 'Ababa' from file";
1a3850a5 51
4beedc23
PP
52if (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}
64else { # 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;
78chomp($word = <DICT>);
79
0b0a7092
CBW
80cmp_ok $pos, ">=", 0;
81is $word, "Aarhus";
55497cff 82
83close 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 104unlink "dict-$$";
0b0a7092
CBW
105
106if ( $] 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}