1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Ause warnings;
1N/Ause Test::More tests => 8;
1N/Ause vars qw( $Term::Complete::complete $complete $Term::Complete::stty );
1N/A
1N/ASKIP: {
1N/A skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST};
1N/A
1N/A use_ok( 'Term::Complete' );
1N/A
1N/A # this skips tests AND prevents the "used only once" warning
1N/A skip('No stty, Term::Complete will not run here', 7)
1N/A unless defined $Term::Complete::tty_raw_noecho &&
1N/A defined $Term::Complete::tty_restore;
1N/A
1N/A # also prevent Term::Complete from running stty and messing up the terminal
1N/A undef $Term::Complete::tty_restore;
1N/A undef $Term::Complete::tty_raw_noecho;
1N/A undef $Term::Complete::stty;
1N/A
1N/A *complete = \$Term::Complete::complete;
1N/A
1N/A my $in = tie *STDIN, 'FakeIn', "fro\t";
1N/A my $out = tie *STDOUT, 'FakeOut';
1N/A my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
1N/A
1N/A Complete('', \@words);
1N/A my $data = get_expected('fro', @words);
1N/A
1N/A # there should be an \a after our word
1N/A like( $$out, qr/fro\a/, 'found bell character' );
1N/A
1N/A # now remove the \a -- there should be only one
1N/A is( $out->scrub(), 1, '(single) bell removed');
1N/A
1N/A # 'fro' should match all three words
1N/A like( $$out, qr/$data/, 'all three words possible' );
1N/A $out->clear();
1N/A
1N/A # should only find 'frobnitz' and 'frobozz'
1N/A $in->add('frob');
1N/A Complete('', @words);
1N/A $out->scrub();
1N/A is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
1N/A $out->clear();
1N/A
1N/A # should only do 'frobozz'
1N/A $in->add('frobo');
1N/A Complete('', @words);
1N/A $out->scrub();
1N/A is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
1N/A $out->clear();
1N/A
1N/A # change the completion character
1N/A $complete = "!";
1N/A $in->add('frobn');
1N/A Complete('prompt:', @words);
1N/A $out->scrub();
1N/A like( $$out, qr/prompt:frobn/, 'prompt is okay' );
1N/A
1N/A # now remove the prompt and we should be okay
1N/A $$out =~ s/prompt://g;
1N/A is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' );
1N/A
1N/A} # end of SKIP, end of tests
1N/A
1N/A# easier than matching space characters
1N/Asub get_expected {
1N/A my $word = shift;
1N/A return join('.', $word, @_, $word, '.');
1N/A}
1N/A
1N/Apackage FakeIn;
1N/A
1N/Asub TIEHANDLE {
1N/A my ($class, $text) = @_;
1N/A $text .= "$main::complete\025";
1N/A bless(\$text, $class);
1N/A}
1N/A
1N/Asub add {
1N/A my ($self, $text) = @_;
1N/A $$self = $text . "$main::complete\025";
1N/A}
1N/A
1N/Asub GETC {
1N/A my $self = shift;
1N/A return length $$self ? substr($$self, 0, 1, '') : "\r";
1N/A}
1N/A
1N/Apackage FakeOut;
1N/A
1N/Asub TIEHANDLE {
1N/A bless(\(my $text), $_[0]);
1N/A}
1N/A
1N/Asub clear {
1N/A ${ $_[0] } = '';
1N/A}
1N/A
1N/A# remove the bell character
1N/Asub scrub {
1N/A ${ $_[0] } =~ tr/\a//d;
1N/A}
1N/A
1N/A# must shift off self
1N/Asub PRINT {
1N/A my $self = shift;
1N/A ($$self .= join('', @_)) =~ s/\s+/./gm;
1N/A}