1#!./perl 2 3use strict; 4use Test::More; 5plan tests => ( $] ge '5.008' ? 14 : 10 ); 6 7my $DICT = <<EOT; 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 38use Tie::Handle; # loads Tie::StdHandle 39use Search::Dict; 40 41open(DICT, '+>', "dict-$$") or die "Can't create dict-$$: $!"; 42binmode DICT; # To make length expected one. 43print DICT $DICT; 44 45my $word; 46 47my $pos = look *DICT, "Ababa"; 48chomp($word = <DICT>); 49cmp_ok $pos, ">=", 0; 50is $word, "Ababa", "found 'Ababa' from file"; 51 52if (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} 64else { # 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; 78chomp($word = <DICT>); 79 80cmp_ok $pos, ">=", 0; 81is $word, "Aarhus"; 82 83close 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 untie *DICT; 103} 104unlink "dict-$$"; 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} 125