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