Commit | Line | Data |
---|---|---|
bbd9de80 | 1 | #!./perl |
2 | ||
bbd9de80 | 3 | use warnings; |
4 | use Test::More tests => 8; | |
25f74a49 | 5 | use vars qw( $Term::Complete::complete $complete $Term::Complete::stty ); |
fc81c880 | 6 | |
cd3eb553 | 7 | SKIP: { |
1f137b8a | 8 | skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST}; |
7f4d7a86 | 9 | |
25f74a49 | 10 | use_ok( 'Term::Complete' ); |
7f4d7a86 | 11 | |
25f74a49 | 12 | # this skips tests AND prevents the "used only once" warning |
b8d190ff | 13 | skip('No stty, Term::Complete will not run here', 7) |
25f74a49 JH |
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); | |
7f4d7a86 | 30 | |
25f74a49 JH |
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' ); | |
fc81c880 JH |
65 | |
66 | } # end of SKIP, end of tests | |
bbd9de80 | 67 | |
68 | # easier than matching space characters | |
69 | sub get_expected { | |
70 | my $word = shift; | |
71 | return join('.', $word, @_, $word, '.'); | |
72 | } | |
73 | ||
74 | package FakeIn; | |
75 | ||
76 | sub TIEHANDLE { | |
77 | my ($class, $text) = @_; | |
78 | $text .= "$main::complete\025"; | |
79 | bless(\$text, $class); | |
80 | } | |
81 | ||
82 | sub add { | |
83 | my ($self, $text) = @_; | |
84 | $$self = $text . "$main::complete\025"; | |
85 | } | |
86 | ||
87 | sub GETC { | |
88 | my $self = shift; | |
89 | return length $$self ? substr($$self, 0, 1, '') : "\r"; | |
90 | } | |
91 | ||
92 | package FakeOut; | |
93 | ||
94 | sub TIEHANDLE { | |
95 | bless(\(my $text), $_[0]); | |
96 | } | |
97 | ||
98 | sub clear { | |
99 | ${ $_[0] } = ''; | |
100 | } | |
101 | ||
102 | # remove the bell character | |
103 | sub scrub { | |
104 | ${ $_[0] } =~ tr/\a//d; | |
105 | } | |
106 | ||
107 | # must shift off self | |
108 | sub PRINT { | |
109 | my $self = shift; | |
110 | ($$self .= join('', @_)) =~ s/\s+/./gm; | |
111 | } |