source: t/completion.t @ 40d22cf

release-1.10release-1.6release-1.7release-1.8release-1.9
Last change on this file since 40d22cf was ccafe64, checked in by David Benjamin <davidben@mit.edu>, 14 years ago
Add additional (failing) tests for completer parse Completer should ignore leading whitespace. Also, to avoid invalid indices and different behavior for first word compared to rest, we change the empty string to give [''] as opposed to []. Signed-off-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 10.1 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
10use BarnOwl::Complete::Filter qw(complete_filter_expr);
11
12=head1 DESCRIPTION
13
14Basic tests for tab-completion functionality.
15
16=cut
17
18sub test_tokenize {
19    local $Test::Builder::Level = $Test::Builder::Level + 1;
20
21    my $before_point = shift;
22    my $after_point = shift;
23   
24    my $ctx = BarnOwl::Completion::Context->new($before_point,
25                                                $after_point);
26    is($ctx->line, $before_point . $after_point);
27    is($ctx->point, length $before_point);
28
29    test_ctx($ctx, @_);
30}
31
32sub test_ctx {
33    local $Test::Builder::Level = $Test::Builder::Level + 1;
34
35    my $ctx = shift;
36
37    my $words = shift;
38    my $word = shift;
39    my $word_point = shift;
40
41    my $word_start = shift;
42    my $word_end   = shift;
43
44    is_deeply($ctx->words, $words);
45    if (defined($word)) {
46        is($ctx->word, $word, "Correct current word.");
47        is($ctx->word_point, $word_point, "Correct point within word.");
48        is($ctx->word_start, $word_start, "Correct start of word");
49        is($ctx->word_end,   $word_end, "Correct end of word");
50    }
51}
52
53sub test_shift {
54    local $Test::Builder::Level = $Test::Builder::Level + 1;
55
56    my $before_point = shift;
57    my $after_point = shift;
58    my $shift = shift;
59   
60    my $ctx = BarnOwl::Completion::Context->new($before_point,
61                                                $after_point);
62    $ctx = $ctx->shift_words($shift);
63
64    test_ctx($ctx, @_);
65}
66
67
68isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context');
69
70no warnings 'qw';
71test_tokenize('Hello, W', 'orld',
72              [qw(Hello, World)], 1, 1, 7, 12);
73
74test_tokenize('Hello, World', '',
75              [qw(Hello, World)], 1, 5, 7, 12);
76
77test_tokenize(" \t Hello, World", '',
78              [qw(Hello, World)], 1, 5, 10, 15);
79
80test_tokenize('', '',
81              [''], 0, 0, 0, 0);
82
83test_tokenize('   ', '',
84              [''], 0, 0, 3, 3);
85
86test_tokenize('Hello', 'World',
87              [qw(HelloWorld)], 0, 5, 0, 10);
88
89test_tokenize(' Hello', 'World',
90              [qw(HelloWorld)], 0, 5, 1, 11);
91
92test_tokenize('lorem ipsum dolor ', 'sit amet',
93              [qw(lorem ipsum dolor sit amet)],
94              3, 0, 18, 21);
95
96test_tokenize(q{error "ls -l failed"}, q{},
97              ['error', 'ls -l failed'],
98              1, 12, 6, 20);
99
100test_tokenize(q{"a long"' word'}, q{},
101              ['a long word']);
102
103test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3);
104
105test_tokenize(q{"Hello, }, q{World"},
106              [q{Hello, World}],
107              0, 7, 0, 14);
108
109test_tokenize(q{But 'Hello, }, q{World'},
110              ['But', q{Hello, World}],
111              1, 7, 4, 18);
112
113test_tokenize(q{But "Hello, }, q{World"''''''""},
114              ['But', q{Hello, World}],
115              1, 7, 4, 26);
116
117test_tokenize(q{}, q{''Hello},
118              ['Hello'],
119              0, 0, 0, 7);
120
121test_tokenize(q{"Hello, }, q{World},
122              [q{Hello, World}],
123              0, 7, 0, 13);
124
125test_tokenize(q{Hello    }, q{World},
126              [qw{Hello World}],
127              1, 0, 9, 14);
128
129test_tokenize(q{Hello '' ""}, q{ World},
130              ["Hello", '', '', 'World'],
131              2, 0, 9, 11);
132
133test_tokenize(q{zwrite -c }, q{},
134              [qw(zwrite -c), ''],
135              2, 0, 10, 10);
136
137# It's not entirely clear what we should do here. Make a test for the
138# current behavior, so we'll notice if it changes.
139test_tokenize(q{Hello }, q{ World},
140              [qw(Hello World)],
141              1, -1, 7, 12);
142
143## Test Context::shift
144test_shift('lorem ipsum dolor ', 'sit amet', 0,
145           [qw(lorem ipsum dolor sit amet)],
146           3, 0, 18, 21);
147
148test_shift('lorem ipsum dolor ', 'sit amet', 1,
149           [qw(ipsum dolor sit amet)],
150           2, 0, 12, 15);
151
152test_shift('lorem ipsum dolor ', 'sit amet', 2,
153           [qw(dolor sit amet)],
154           1, 0, 6, 9);
155
156test_shift('lorem ipsum dolor ', 'sit amet', 3,
157           [qw(sit amet)],
158           0, 0, 0, 3);
159
160eval {
161    my $before_point = 'lorem ipsum dolor';
162    my $after_point = 'sit amet';
163    my $shift = 4;
164
165    my $ctx = BarnOwl::Completion::Context->new($before_point,
166                                                $after_point);
167    $ctx = $ctx->shift_words($shift);
168};
169like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point");
170
171## Test common_prefix
172
173is(BarnOwl::Completion::common_prefix(qw(a b)), '');
174is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a');
175
176is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa');
177
178is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a');
179
180is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc');
181
182is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc');
183
184is(BarnOwl::Completion::common_prefix('a', ''), '');
185
186## Test complete_flags
187
188use BarnOwl::Completion::Util qw(complete_flags);
189
190# dummy complete_zwrite
191sub complete_zwrite {
192    my $ctx = shift;
193    return complete_flags($ctx,
194                          [qw(-n -C -m)],
195                          {
196                              "-c" => sub {qw(nelhage nethack sipb help)},
197                              "-i" => sub {qw()},
198                              "-r" => sub {qw(ATHENA.MIT.EDU ZONE.MIT.EDU ANDREW.CMU.EDU)},
199                              "-O" => sub {qw()},
200                          },
201                          sub {qw(nelhage asedeno geofft)});
202}
203
204sub test_complete {
205    my $before = shift;
206    my $after = shift;
207    my $words = shift;
208    my $complete = shift || \&complete_zwrite;
209   
210    my $ctx = BarnOwl::Completion::Context->new($before, $after);
211
212    local $Test::Builder::Level = $Test::Builder::Level + 1;
213
214    my @got = $complete->($ctx);
215    is_deeply([sort @got], [sort @$words]);
216}
217
218test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]);
219
220test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]);
221
222test_complete('zwrite -c nelhage -i ', '', [qw()]);
223
224test_complete('zwrite -c nelhage ', '',
225              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
226
227test_complete('zwrite -c nelhage ', '-',
228              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
229
230test_complete('zwrite -c nelhage -- ', '',
231              [qw(nelhage asedeno geofft)]);
232
233sub complete_word {
234    my $ctx = shift;
235    return complete_flags($ctx,
236                          [qw(-a -b -c)],
237                          {
238                              "-d" => sub {qw(some words for completing)},
239                          },
240                          sub {$_[1]},
241                          repeat_flags => 1);
242}
243
244test_complete('cmd -a -d foo -c hello ','',
245              [qw(-a -b -c -d 1)], \&complete_word);
246
247test_complete('cmd -a -d foo -c ','',
248              [qw(-a -b -c -d 0)], \&complete_word);
249
250# Test that words after -- are counted properly.
251test_complete('cmd -- hi there ','',
252              [qw(2)], \&complete_word);
253
254test_complete('cmd --','',
255              [qw(-a -b -c -d 0)], \&complete_word);
256
257test_complete('cmd -- ','',
258              [qw(0)], \&complete_word);
259
260test_complete('cmd foo -- ','',
261              [qw(1)], \&complete_word);
262
263test_complete('cmd foo -- bar ','',
264              [qw(2)], \&complete_word);
265
266
267# Test the filter expression completer
268test_complete('', '',
269              [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]],
270              \&complete_filter_expr);
271
272test_complete('not ', '',
273              [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]],
274              \&complete_filter_expr);
275
276test_complete('true ', '',
277              [qw[and or]],
278              \&complete_filter_expr);
279
280test_complete('( true ', '',
281              [qw[and or )]],
282              \&complete_filter_expr);
283
284test_complete('( body static and body analysis and not false and class davidben and ( instance python or instance hotd ', '',
285              [qw[and or )]],
286              \&complete_filter_expr);
287
288test_complete('type ', '',
289              [qw[admin aim zephyr]],
290              \&complete_filter_expr);
291
292test_complete('direction ', '',
293              [qw[in out none]],
294              \&complete_filter_expr);
295
296test_complete('login ', '',
297              [qw[login logout none]],
298              \&complete_filter_expr);
299
300# Test complete_files
301use BarnOwl::Completion::Util qw(complete_file);
302use File::Temp;
303use File::Path qw(mkpath);
304
305my $tmpdir = File::Temp::tempdir(CLEANUP => 1);
306
307# Make sure $tmpdir does not have a trailing /
308$tmpdir =~ s{/$}{};
309$ENV{HOME} = $tmpdir;
310
311sub touch {
312    my $path = shift;
313    system("touch", "$path");
314}
315
316mkpath("$tmpdir/.owl/",
317       "$tmpdir/.owl/modules/",
318       "$tmpdir/Public/",
319       "$tmpdir/Private/",
320       "$tmpdir/.ours",
321       "$tmpdir/www",
322     {mode => 0700});
323touch("$tmpdir/.zephyr.subs");
324touch("$tmpdir/wheee");
325touch("$tmpdir/.owl/startup");
326
327sub completion_value {
328    my $c = shift;
329    return $c unless ref($c) eq 'ARRAY';
330    return $c->[1];
331}
332
333sub test_file {
334    my $spec  = shift;
335    my $pfx   = shift;
336    my $dirs  = shift;
337    my $files = shift;
338
339    my $expect = [ sort {$a->[1] cmp $b->[1]}
340        ((map {["$_/", defined($pfx)?"$pfx/$_/":"$_/", 0]} @$dirs),
341         (map {["$_",  defined($pfx)?"$pfx/$_" :$_   , 1]} @$files))
342       ];
343
344    local $Test::Builder::Level = $Test::Builder::Level + 1;
345
346    my @got = complete_file($spec);
347
348    @got = grep {completion_value($_) =~ m{^\Q$spec\E}} @got;
349    @got = sort {completion_value($a) cmp completion_value($b)} @got;
350
351    use Data::Dumper;
352    is_deeply(\@got, $expect);
353}
354
355is_deeply([complete_file("~")], [["~/", "~/", 0]]);
356
357END { chdir("/"); }
358chdir($tmpdir);
359test_file("$tmpdir/", $tmpdir,
360          [qw(Public Private www)],
361          [qw(wheee)]);
362
363test_file("./", ".",
364          [qw(Public Private www)],
365          [qw(wheee)]);
366
367test_file("", undef, [qw(Public Private www)], [qw(wheee)]);
368
369test_file("./.owl/", "./.owl",
370          [qw(modules)],
371          [qw(startup)]);
372
373test_file("~/", "~",
374          [qw(Public Private www)],
375          [qw(wheee)]);
376
377test_file("P", undef, [qw(Public Private)], []);
378
379test_file("$tmpdir/.", $tmpdir,
380          [qw(. .. .owl .ours)],
381          [qw(.zephyr.subs)]);
3821;
383
Note: See TracBrowser for help on using the repository browser.