diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/Term/Complete.t | 101 |
2 files changed, 102 insertions, 0 deletions
@@ -1124,6 +1124,7 @@ lib/Term/ANSIColor/README Term::ANSIColor lib/Term/ANSIColor/test.pl See if Term::ANSIColor works lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine +lib/Term/Complete.t See if Term::Complete works lib/Term/ReadLine.pm Stub readline library lib/termcap.pl Perl library supporting termcap usage lib/Test.pm A simple framework for writing test scripts diff --git a/lib/Term/Complete.t b/lib/Term/Complete.t new file mode 100644 index 0000000000..ff62d1d871 --- /dev/null +++ b/lib/Term/Complete.t @@ -0,0 +1,101 @@ +#!./perl + +BEGIN { + chdir 't' unless -d 't'; + @INC = '../lib'; +} + +use warnings; +use Test::More tests => 8; +use vars qw( $Term::Complete::complete $complete ); + +use_ok( 'Term::Complete' ); + +*complete = \$Term::Complete::complete; + +my $in = tie *STDIN, 'FakeIn', "fro\t"; +my $out = tie *STDOUT, 'FakeOut'; +my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' ); + +Complete('', \@words); +my $data = get_expected('fro', @words); + +# there should be an \a after our word +like( $$out, qr/fro\a/, 'found bell character' ); + +# now remove the \a -- there should be only one +is( $out->scrub(), 1, '(single) bell removed'); + +# 'fro' should match all three words +like( $$out, qr/$data/, 'all three words possible' ); +$out->clear(); + +# should only find 'frobnitz' and 'frobozz' +$in->add('frob'); +Complete('', @words); +$out->scrub(); +is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' ); +$out->clear(); + +# should only do 'frobozz' +$in->add('frobo'); +Complete('', @words); +$out->scrub(); +is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' ); +$out->clear(); + +# change the completion character +$complete = "!"; +$in->add('frobn'); +Complete('prompt:', @words); +$out->scrub(); +like( $$out, qr/prompt:frobn/, 'prompt is okay' ); + +# now remove the prompt and we should be okay +$$out =~ s/prompt://g; +is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' ); + +# easier than matching space characters +sub get_expected { + my $word = shift; + return join('.', $word, @_, $word, '.'); +} + +package FakeIn; + +sub TIEHANDLE { + my ($class, $text) = @_; + $text .= "$main::complete\025"; + bless(\$text, $class); +} + +sub add { + my ($self, $text) = @_; + $$self = $text . "$main::complete\025"; +} + +sub GETC { + my $self = shift; + return length $$self ? substr($$self, 0, 1, '') : "\r"; +} + +package FakeOut; + +sub TIEHANDLE { + bless(\(my $text), $_[0]); +} + +sub clear { + ${ $_[0] } = ''; +} + +# remove the bell character +sub scrub { + ${ $_[0] } =~ tr/\a//d; +} + +# must shift off self +sub PRINT { + my $self = shift; + ($$self .= join('', @_)) =~ s/\s+/./gm; +} |