source: t/completion.t @ 80b5c42

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