lib/Term/Complete.t

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