source: t/completion.t @ b06a888

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since b06a888 was e97c5d05, checked in by David Benjamin <davidben@mit.edu>, 15 years ago
Implement a shift_words method on completion contexts. This allows completion methods to easily pass on the remainder of a command-line to another completer if appropriate.
  • Property mode set to 100644
File size: 6.6 KB
Line 
1#!/usr/bin/env perl
2use strict;
3use warnings;
4
5use Test::More qw(no_plan);
6
7use File::Basename;
8BEGIN {require (dirname($0) . "/mock.pl");};
9
10=head1 DESCRIPTION
11
12Basic tests for tab-completion functionality.
13
14=cut
15
16sub test_tokenize {
17    local $Test::Builder::Level = $Test::Builder::Level + 1;
18
19    my $before_point = shift;
20    my $after_point = shift;
21   
22    my $ctx = BarnOwl::Completion::Context->new($before_point,
23                                                $after_point);
24    is($ctx->line, $before_point . $after_point);
25    is($ctx->point, length $before_point);
26
27    test_ctx($ctx, @_);
28}
29
30sub test_ctx {
31    local $Test::Builder::Level = $Test::Builder::Level + 1;
32
33    my $ctx = shift;
34
35    my $words = shift;
36    my $word = shift;
37    my $word_point = shift;
38
39    my $word_start = shift;
40    my $word_end   = shift;
41
42    is_deeply($ctx->words, $words);
43    if (defined($word)) {
44        is($ctx->word, $word, "Correct current word.");
45        is($ctx->word_point, $word_point, "Correct point within word.");
46        is($ctx->word_start, $word_start, "Correct start of word");
47        is($ctx->word_end,   $word_end, "Correct end of word");
48    }
49}
50
51sub test_shift {
52    local $Test::Builder::Level = $Test::Builder::Level + 1;
53
54    my $before_point = shift;
55    my $after_point = shift;
56    my $shift = shift;
57   
58    my $ctx = BarnOwl::Completion::Context->new($before_point,
59                                                $after_point);
60    $ctx = $ctx->shift_words($shift);
61
62    test_ctx($ctx, @_);
63}
64
65
66isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context');
67
68no warnings 'qw';
69test_tokenize('Hello, W', 'orld',
70              [qw(Hello, World)], 1, 1, 7, 12);
71
72test_tokenize('Hello, World', '',
73              [qw(Hello, World)], 1, 5, 7, 12);
74
75test_tokenize('', '',
76              [qw()], 0, 0, 0, 0);
77
78test_tokenize('Hello', 'World',
79              [qw(HelloWorld)], 0, 5, 0, 10);
80
81test_tokenize('lorem ipsum dolor ', 'sit amet',
82              [qw(lorem ipsum dolor sit amet)],
83              3, 0, 18, 21);
84
85test_tokenize(q{error "ls -l failed"}, q{},
86              ['error', 'ls -l failed'],
87              1, 12, 6, 20);
88
89test_tokenize(q{"a long"' word'}, q{},
90              ['a long word']);
91
92test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3);
93
94test_tokenize(q{"Hello, }, q{World"},
95              [q{Hello, World}],
96              0, 7, 0, 14);
97
98test_tokenize(q{But 'Hello, }, q{World'},
99              ['But', q{Hello, World}],
100              1, 7, 4, 18);
101
102test_tokenize(q{But "Hello, }, q{World"''''''""},
103              ['But', q{Hello, World}],
104              1, 7, 4, 26);
105
106test_tokenize(q{}, q{''Hello},
107              ['Hello'],
108              0, 0, 0, 7);
109
110test_tokenize(q{"Hello, }, q{World},
111              [q{Hello, World}],
112              0, 7, 0, 13);
113
114test_tokenize(q{Hello    }, q{World},
115              [qw{Hello World}],
116              1, 0, 9, 14);
117
118test_tokenize(q{Hello '' ""}, q{ World},
119              ["Hello", '', '', 'World'],
120              2, 0, 9, 11);
121
122test_tokenize(q{zwrite -c }, q{},
123              [qw(zwrite -c), ''],
124              2, 0, 10, 10);
125
126# It's not entirely clear what we should do here. Make a test for the
127# current behavior, so we'll notice if it changes.
128test_tokenize(q{Hello }, q{ World},
129              [qw(Hello World)],
130              1, -1, 7, 12);
131
132## Test Context::shift
133SKIP: {
134    skip "Can't yet test code that depends on perlglue.xs", 4;
135    test_shift('lorem ipsum dolor ', 'sit amet', 0,
136               [qw(lorem ipsum dolor sit amet)],
137               3, 0, 18, 21);
138
139    test_shift('lorem ipsum dolor ', 'sit amet', 1,
140               [qw(lorem ipsum dolor sit amet)],
141               2, 0, 12, 15);
142
143    test_shift('lorem ipsum dolor ', 'sit amet', 2,
144               [qw(lorem ipsum dolor sit amet)],
145               1, 0, 6, 9);
146
147    test_shift('lorem ipsum dolor ', 'sit amet', 3,
148               [qw(lorem ipsum dolor sit amet)],
149               0, 0, 0, 3);
150
151}
152## Test common_prefix
153
154is(BarnOwl::Completion::common_prefix(qw(a b)), '');
155is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a');
156
157is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa');
158
159is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a');
160
161is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc');
162
163is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc');
164
165is(BarnOwl::Completion::common_prefix('a', ''), '');
166
167## Test complete_flags
168
169use BarnOwl::Completion::Util qw(complete_flags);
170
171# dummy complete_zwrite
172sub complete_zwrite {
173    my $ctx = shift;
174    return complete_flags($ctx,
175                          [qw(-n -C -m)],
176                          {
177                              "-c" => sub {qw(nelhage nethack sipb help)},
178                              "-i" => sub {qw()},
179                              "-r" => sub {qw(ATHENA.MIT.EDU ZONE.MIT.EDU ANDREW.CMU.EDU)},
180                              "-O" => sub {qw()},
181                          },
182                          sub {qw(nelhage asedeno geofft)});
183}
184
185sub test_complete {
186    my $before = shift;
187    my $after = shift;
188    my $words = shift;
189    my $complete = shift || \&complete_zwrite;
190   
191    my $ctx = BarnOwl::Completion::Context->new($before, $after);
192
193    local $Test::Builder::Level = $Test::Builder::Level + 1;
194
195    my @got = $complete->($ctx);
196    is_deeply([sort @got], [sort @$words]);
197}
198
199test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]);
200
201test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]);
202
203test_complete('zwrite -c nelhage -i ', '', [qw()]);
204
205test_complete('zwrite -c nelhage ', '',
206              [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]);
207
208test_complete('zwrite -c nelhage ', '-',
209              [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]);
210
211test_complete('zwrite -c nelhage -- ', '',
212              [qw(nelhage asedeno geofft)]);
213
214sub complete_word {
215    my $ctx = shift;
216    return complete_flags($ctx,
217                          [qw(-a -b -c)],
218                          {
219                              "-d" => sub {qw(some words for completing)},
220                          },
221                          sub {$_[1]});
222}
223
224test_complete('cmd -a -d foo -c hello ','',
225              [qw(-a -b -c -d 1)], \&complete_word);
226
227test_complete('cmd -a -d foo -c ','',
228              [qw(-a -b -c -d 0)], \&complete_word);
229
230# Test that words after -- are counted properly.
231test_complete('cmd -- hi there ','',
232              [qw(2)], \&complete_word);
233
234test_complete('cmd --','',
235              [qw(-a -b -c -d 0)], \&complete_word);
236
237test_complete('cmd -- ','',
238              [qw(0)], \&complete_word);
239
240test_complete('cmd foo -- ','',
241              [qw(1)], \&complete_word);
242
243test_complete('cmd foo -- bar ','',
244              [qw(2)], \&complete_word);
245
2461;
247
Note: See TracBrowser for help on using the repository browser.