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 my $restore;
  12
  13 SKIP: {
  14     skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST};
  15
  16     my $TTY;
  17     if ($^O eq 'rhapsody' && -c "/dev/ttyp0") { $TTY = "/dev/ttyp0" }
  18     elsif (-c "/dev/tty")                     { $TTY = "/dev/tty"   }
  19     if (defined $TTY) {
  20         open(TTY, $TTY)               or die "open $TTY failed: $!";
  21         skip("$TTY not a tty", 8)     if defined $TTY && ! -t TTY;
  22         $restore = `stty -g`;
  23         skip("Can't reliably restore $TTY", 8) if $?;
  24     }
  25
  26 use_ok( 'Term::Complete' );
  27
  28 *complete = \$Term::Complete::complete;
  29
  30 my $in = tie *STDIN, 'FakeIn', "fro\t";
  31 my $out = tie *STDOUT, 'FakeOut';
  32 my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
  33
  34 Complete('', \@words);
  35 my $data = get_expected('fro', @words);
  36
  37 # there should be an \a after our word
  38 like( $$out, qr/fro\a/, 'found bell character' );
  39
  40 # now remove the \a -- there should be only one
  41 is( $out->scrub(), 1, '(single) bell removed');
  42
  43 # 'fro' should match all three words
  44 like( $$out, qr/$data/, 'all three words possible' );
  45 $out->clear();
  46
  47 # should only find 'frobnitz' and 'frobozz'
  48 $in->add('frob');
  49 Complete('', @words);
  50 $out->scrub();
  51 is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
  52 $out->clear();
  53
  54 # should only do 'frobozz'
  55 $in->add('frobo');
  56 Complete('', @words);
  57 $out->scrub();
  58 is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
  59 $out->clear();
  60
  61 # change the completion character
  62 $complete = "!";
  63 $in->add('frobn');
  64 Complete('prompt:', @words);
  65 $out->scrub();
  66 like( $$out, qr/prompt:frobn/, 'prompt is okay' );
  67
  68 # now remove the prompt and we should be okay
  69 $$out =~ s/prompt://g;
  70 is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' );
  71
  72 `stty $restore` if defined $restore;
  73
  74 } # end of SKIP, end of tests
  75
  76 # easier than matching space characters
  77 sub get_expected {
  78         my $word = shift;
  79         return join('.', $word, @_, $word, '.');
  80 }
  81
  82 package FakeIn;
  83
  84 sub TIEHANDLE {
  85         my ($class, $text) = @_;
  86         $text .= "$main::complete\025";
  87         bless(\$text, $class);
  88 }
  89
  90 sub add {
  91         my ($self, $text) = @_;
  92         $$self = $text . "$main::complete\025";
  93 }
  94
  95 sub GETC {
  96         my $self = shift;
  97         return length $$self ? substr($$self, 0, 1, '') : "\r";
  98 }
  99
 100 package FakeOut;
 101
 102 sub TIEHANDLE {
 103         bless(\(my $text), $_[0]);
 104 }
 105
 106 sub clear {
 107         ${ $_[0] } = '';
 108 }
 109
 110 # remove the bell character
 111 sub scrub {
 112         ${ $_[0] } =~ tr/\a//d;
 113 }
 114
 115 # must shift off self
 116 sub PRINT {
 117         my $self = shift;
 118         ($$self .= join('', @_)) =~ s/\s+/./gm;
 119 }