This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use minimal @INC in tests, most of the time just '../lib',
[perl5.git] / t / lib / searchdict.t
... / ...
CommitLineData
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8print "1..4\n";
9
10$DICT = <<EOT;
11Aarhus
12Aaron
13Ababa
14aback
15abaft
16abandon
17abandoned
18abandoning
19abandonment
20abandons
21abase
22abased
23abasement
24abasements
25abases
26abash
27abashed
28abashes
29abashing
30abasing
31abate
32abated
33abatement
34abatements
35abater
36abates
37abating
38Abba
39EOT
40
41use Search::Dict;
42
43open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
44binmode DICT; # To make length expected one.
45print DICT $DICT;
46
47my $pos = look *DICT, "Ababa";
48chomp($word = <DICT>);
49print "not " if $pos < 0 || $word ne "Ababa";
50print "ok 1\n";
51
52if (ord('a') > ord('A') ) { # ASCII
53
54 $pos = look *DICT, "foo";
55 chomp($word = <DICT>);
56
57 print "not " if $pos != length($DICT); # will search to end of file
58 print "ok 2\n";
59
60 my $pos = look *DICT, "abash";
61 chomp($word = <DICT>);
62 print "not " if $pos < 0 || $word ne "abash";
63 print "ok 3\n";
64
65}
66else { # EBCDIC systems e.g. os390
67
68 $pos = look *DICT, "FOO";
69 chomp($word = <DICT>);
70
71 print "not " if $pos != length($DICT); # will search to end of file
72 print "ok 2\n";
73
74 my $pos = look *DICT, "Abba";
75 chomp($word = <DICT>);
76 print "not " if $pos < 0 || $word ne "Abba";
77 print "ok 3\n";
78}
79
80$pos = look *DICT, "aarhus", 1, 1;
81chomp($word = <DICT>);
82
83print "not " if $pos < 0 || $word ne "Aarhus";
84print "ok 4\n";
85
86close DICT or die "cannot close";
87unlink "dict-$$";