lib/Term/Complete.t

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