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   untie *DICT;
 103 }
 104 unlink "dict-$$";
 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 }