9 use Test::More tests => 8;
10 use vars qw( $Term::Complete::complete $complete $Term::Complete::stty );
13 skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST};
15 use_ok( 'Term::Complete' );
17 # this skips tests AND prevents the "used only once" warning
18 skip('No stty, Term::Complete will not run here', 8)
19 unless defined $Term::Complete::tty_raw_noecho &&
20 defined $Term::Complete::tty_restore;
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;
27 *complete = \$Term::Complete::complete;
29 my $in = tie *STDIN, 'FakeIn', "fro\t";
30 my $out = tie *STDOUT, 'FakeOut';
31 my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
33 Complete('', \@words);
34 my $data = get_expected('fro', @words);
36 # there should be an \a after our word
37 like( $$out, qr/fro\a/, 'found bell character' );
39 # now remove the \a -- there should be only one
40 is( $out->scrub(), 1, '(single) bell removed');
42 # 'fro' should match all three words
43 like( $$out, qr/$data/, 'all three words possible' );
46 # should only find 'frobnitz' and 'frobozz'
50 is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
53 # should only do 'frobozz'
57 is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
60 # change the completion character
63 Complete('prompt:', @words);
65 like( $$out, qr/prompt:frobn/, 'prompt is okay' );
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' );
71 } # end of SKIP, end of tests
73 # easier than matching space characters
76 return join('.', $word, @_, $word, '.');
82 my ($class, $text) = @_;
83 $text .= "$main::complete\025";
84 bless(\$text, $class);
88 my ($self, $text) = @_;
89 $$self = $text . "$main::complete\025";
94 return length $$self ? substr($$self, 0, 1, '') : "\r";
100 bless(\(my $text), $_[0]);
107 # remove the bell character
109 ${ $_[0] } =~ tr/\a//d;
112 # must shift off self
115 ($$self .= join('', @_)) =~ s/\s+/./gm;