source: t/completion.t

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