Change 11959 by jhi@alpha on 2001/09/09 13:16:43
Subject: [PATCH MANIFEST, lib/Term/Complete.t] Add Test for Term::Complete
From: "chromatic" <[EMAIL PROTECTED]>
Date: Sat, 08 Sep 2001 19:33:42 -0600
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/MANIFEST#550 edit
... //depot/perl/lib/Term/Complete.t#1 add
Differences ...
==== //depot/perl/MANIFEST#550 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Sun Sep 9 07:30:05 2001
+++ perl/MANIFEST Sun Sep 9 07:30:05 2001
@@ -1124,6 +1124,7 @@
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
==== //depot/perl/lib/Term/Complete.t#1 (text) ====
Index: perl/lib/Term/Complete.t
--- perl/lib/Term/Complete.t.~1~ Sun Sep 9 07:30:05 2001
+++ perl/lib/Term/Complete.t Sun Sep 9 07:30:05 2001
@@ -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;
+}
End of Patch.
