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