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