lib/Term/Complete.t

   1 #!./perl
   2
   3 BEGIN {
   4         chdir 't' unless -d 't';
   5         @INC = '../lib';
   6 }
   7
   8 use warnings;
   9 use Test::More tests => 8;
  10 use vars qw( $Term::Complete::complete $complete );
  11
  12 use_ok( 'Term::Complete' );
  13
  14 *complete = \$Term::Complete::complete;
  15
  16 my $in = tie *STDIN, 'FakeIn', "fro\t";
  17 my $out = tie *STDOUT, 'FakeOut';
  18 my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
  19
  20 Complete('', \@words);
  21 my $data = get_expected('fro', @words);
  22
  23 # there should be an \a after our word
  24 like( $$out, qr/fro\a/, 'found bell character' );
  25
  26 # now remove the \a -- there should be only one
  27 is( $out->scrub(), 1, '(single) bell removed');
  28
  29 # 'fro' should match all three words
  30 like( $$out, qr/$data/, 'all three words possible' );
  31 $out->clear();
  32
  33 # should only find 'frobnitz' and 'frobozz'
  34 $in->add('frob');
  35 Complete('', @words);
  36 $out->scrub();
  37 is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
  38 $out->clear();
  39
  40 # should only do 'frobozz'
  41 $in->add('frobo');
  42 Complete('', @words);
  43 $out->scrub();
  44 is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
  45 $out->clear();
  46
  47 # change the completion character
  48 $complete = "!";
  49 $in->add('frobn');
  50 Complete('prompt:', @words);
  51 $out->scrub();
  52 like( $$out, qr/prompt:frobn/, 'prompt is okay' );
  53
  54 # now remove the prompt and we should be okay
  55 $$out =~ s/prompt://g;
  56 is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' );
  57
  58 # easier than matching space characters
  59 sub get_expected {
  60         my $word = shift;
  61         return join('.', $word, @_, $word, '.');
  62 }
  63
  64 package FakeIn;
  65
  66 sub TIEHANDLE {
  67         my ($class, $text) = @_;
  68         $text .= "$main::complete\025";
  69         bless(\$text, $class);
  70 }
  71
  72 sub add {
  73         my ($self, $text) = @_;
  74         $$self = $text . "$main::complete\025";
  75 }
  76
  77 sub GETC {
  78         my $self = shift;
  79         return length $$self ? substr($$self, 0, 1, '') : "\r";
  80 }
  81
  82 package FakeOut;
  83
  84 sub TIEHANDLE {
  85         bless(\(my $text), $_[0]);
  86 }
  87
  88 sub clear {
  89         ${ $_[0] } = '';
  90 }
  91
  92 # remove the bell character
  93 sub scrub {
  94         ${ $_[0] } =~ tr/\a//d;
  95 }
  96
  97 # must shift off self
  98 sub PRINT {
  99         my $self = shift;
 100         ($$self .= join('', @_)) =~ s/\s+/./gm;
 101 }