1 | #!/usr/bin/env perl |
---|
2 | use strict; |
---|
3 | use warnings; |
---|
4 | |
---|
5 | use Test::More qw(no_plan); |
---|
6 | |
---|
7 | use File::Basename; |
---|
8 | use File::Spec; |
---|
9 | BEGIN {require File::Spec->rel2abs("mock.pl", dirname($0));}; |
---|
10 | |
---|
11 | use BarnOwl::Complete::Filter qw(complete_filter_expr); |
---|
12 | |
---|
13 | =head1 DESCRIPTION |
---|
14 | |
---|
15 | Basic tests for tab-completion functionality. |
---|
16 | |
---|
17 | =cut |
---|
18 | |
---|
19 | sub 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 | |
---|
33 | sub 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 | |
---|
54 | sub 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 | |
---|
69 | isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context'); |
---|
70 | |
---|
71 | no warnings 'qw'; |
---|
72 | test_tokenize('Hello, W', 'orld', |
---|
73 | [qw(Hello, World)], 1, 1, 7, 12); |
---|
74 | |
---|
75 | test_tokenize('Hello, World', '', |
---|
76 | [qw(Hello, World)], 1, 5, 7, 12); |
---|
77 | |
---|
78 | test_tokenize(" \t Hello, World", '', |
---|
79 | [qw(Hello, World)], 1, 5, 10, 15); |
---|
80 | |
---|
81 | test_tokenize('', '', |
---|
82 | [''], 0, 0, 0, 0); |
---|
83 | |
---|
84 | test_tokenize(' ', '', |
---|
85 | [''], 0, 0, 3, 3); |
---|
86 | |
---|
87 | test_tokenize('Hello', 'World', |
---|
88 | [qw(HelloWorld)], 0, 5, 0, 10); |
---|
89 | |
---|
90 | test_tokenize(' Hello', 'World', |
---|
91 | [qw(HelloWorld)], 0, 5, 1, 11); |
---|
92 | |
---|
93 | test_tokenize('lorem ipsum dolor ', 'sit amet', |
---|
94 | [qw(lorem ipsum dolor sit amet)], |
---|
95 | 3, 0, 18, 21); |
---|
96 | |
---|
97 | test_tokenize(q{error "ls -l failed"}, q{}, |
---|
98 | ['error', 'ls -l failed'], |
---|
99 | 1, 12, 6, 20); |
---|
100 | |
---|
101 | test_tokenize(q{"a long"' word'}, q{}, |
---|
102 | ['a long word']); |
---|
103 | |
---|
104 | test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3); |
---|
105 | |
---|
106 | test_tokenize(q{"Hello, }, q{World"}, |
---|
107 | [q{Hello, World}], |
---|
108 | 0, 7, 0, 14); |
---|
109 | |
---|
110 | test_tokenize(q{But 'Hello, }, q{World'}, |
---|
111 | ['But', q{Hello, World}], |
---|
112 | 1, 7, 4, 18); |
---|
113 | |
---|
114 | test_tokenize(q{But "Hello, }, q{World"''''''""}, |
---|
115 | ['But', q{Hello, World}], |
---|
116 | 1, 7, 4, 26); |
---|
117 | |
---|
118 | test_tokenize(q{}, q{''Hello}, |
---|
119 | ['Hello'], |
---|
120 | 0, 0, 0, 7); |
---|
121 | |
---|
122 | test_tokenize(q{"Hello, }, q{World}, |
---|
123 | [q{Hello, World}], |
---|
124 | 0, 7, 0, 13); |
---|
125 | |
---|
126 | test_tokenize(q{Hello }, q{World}, |
---|
127 | [qw{Hello World}], |
---|
128 | 1, 0, 9, 14); |
---|
129 | |
---|
130 | test_tokenize(q{Hello '' ""}, q{ World}, |
---|
131 | ["Hello", '', '', 'World'], |
---|
132 | 2, 0, 9, 11); |
---|
133 | |
---|
134 | test_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. |
---|
140 | test_tokenize(q{Hello }, q{ World}, |
---|
141 | [qw(Hello World)], |
---|
142 | 1, -1, 7, 12); |
---|
143 | |
---|
144 | ## Test Context::shift |
---|
145 | test_shift('lorem ipsum dolor ', 'sit amet', 0, |
---|
146 | [qw(lorem ipsum dolor sit amet)], |
---|
147 | 3, 0, 18, 21); |
---|
148 | |
---|
149 | test_shift('lorem ipsum dolor ', 'sit amet', 1, |
---|
150 | [qw(ipsum dolor sit amet)], |
---|
151 | 2, 0, 12, 15); |
---|
152 | |
---|
153 | test_shift('lorem ipsum dolor ', 'sit amet', 2, |
---|
154 | [qw(dolor sit amet)], |
---|
155 | 1, 0, 6, 9); |
---|
156 | |
---|
157 | test_shift('lorem ipsum dolor ', 'sit amet', 3, |
---|
158 | [qw(sit amet)], |
---|
159 | 0, 0, 0, 3); |
---|
160 | |
---|
161 | eval { |
---|
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 | }; |
---|
170 | like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point"); |
---|
171 | |
---|
172 | ## Test common_prefix |
---|
173 | |
---|
174 | is(BarnOwl::Completion::common_prefix(qw(a b)), ''); |
---|
175 | is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a'); |
---|
176 | |
---|
177 | is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa'); |
---|
178 | |
---|
179 | is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a'); |
---|
180 | |
---|
181 | is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc'); |
---|
182 | |
---|
183 | is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc'); |
---|
184 | |
---|
185 | is(BarnOwl::Completion::common_prefix('a', ''), ''); |
---|
186 | |
---|
187 | ## Test complete_flags |
---|
188 | |
---|
189 | use BarnOwl::Completion::Util qw(complete_flags); |
---|
190 | |
---|
191 | # dummy complete_zwrite |
---|
192 | sub 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 | |
---|
205 | sub 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 | |
---|
219 | test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]); |
---|
220 | |
---|
221 | test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]); |
---|
222 | |
---|
223 | test_complete('zwrite -c nelhage -i ', '', [qw()]); |
---|
224 | |
---|
225 | test_complete('zwrite -c nelhage ', '', |
---|
226 | [qw(-n -C -m -i -r -O nelhage asedeno geofft)]); |
---|
227 | |
---|
228 | test_complete('zwrite -c nelhage ', '-', |
---|
229 | [qw(-n -C -m -i -r -O nelhage asedeno geofft)]); |
---|
230 | |
---|
231 | test_complete('zwrite -c nelhage -- ', '', |
---|
232 | [qw(nelhage asedeno geofft)]); |
---|
233 | |
---|
234 | sub 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 | |
---|
245 | test_complete('cmd -a -d foo -c hello ','', |
---|
246 | [qw(-a -b -c -d 1)], \&complete_word); |
---|
247 | |
---|
248 | test_complete('cmd -a -d foo -c ','', |
---|
249 | [qw(-a -b -c -d 0)], \&complete_word); |
---|
250 | |
---|
251 | # Test that words after -- are counted properly. |
---|
252 | test_complete('cmd -- hi there ','', |
---|
253 | [qw(2)], \&complete_word); |
---|
254 | |
---|
255 | test_complete('cmd --','', |
---|
256 | [qw(-a -b -c -d 0)], \&complete_word); |
---|
257 | |
---|
258 | test_complete('cmd -- ','', |
---|
259 | [qw(0)], \&complete_word); |
---|
260 | |
---|
261 | test_complete('cmd foo -- ','', |
---|
262 | [qw(1)], \&complete_word); |
---|
263 | |
---|
264 | test_complete('cmd foo -- bar ','', |
---|
265 | [qw(2)], \&complete_word); |
---|
266 | |
---|
267 | |
---|
268 | # Test the filter expression completer |
---|
269 | |
---|
270 | sub toplevel_filter_expect { |
---|
271 | return [sort(keys %BarnOwl::Complete::Filter::filter_cmds, qw[( not true false])]; |
---|
272 | } |
---|
273 | |
---|
274 | test_complete('', '', |
---|
275 | toplevel_filter_expect(), |
---|
276 | \&complete_filter_expr); |
---|
277 | |
---|
278 | test_complete('not ', '', |
---|
279 | toplevel_filter_expect(), |
---|
280 | \&complete_filter_expr); |
---|
281 | |
---|
282 | test_complete('true ', '', |
---|
283 | [qw[and or]], |
---|
284 | \&complete_filter_expr); |
---|
285 | |
---|
286 | test_complete('( true ', '', |
---|
287 | [qw[and or )]], |
---|
288 | \&complete_filter_expr); |
---|
289 | |
---|
290 | test_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 | |
---|
294 | test_complete('type ', '', |
---|
295 | [qw[admin zephyr]], |
---|
296 | \&complete_filter_expr); |
---|
297 | |
---|
298 | test_complete('direction ', '', |
---|
299 | [qw[in out none]], |
---|
300 | \&complete_filter_expr); |
---|
301 | |
---|
302 | test_complete('login ', '', |
---|
303 | [qw[login logout none]], |
---|
304 | \&complete_filter_expr); |
---|
305 | |
---|
306 | test_complete('deleted ', '', |
---|
307 | [qw[true false]], |
---|
308 | \&complete_filter_expr); |
---|
309 | |
---|
310 | # Test complete_files |
---|
311 | use BarnOwl::Completion::Util qw(complete_file); |
---|
312 | use File::Temp; |
---|
313 | use File::Path qw(mkpath); |
---|
314 | |
---|
315 | my $tmpdir = File::Temp::tempdir(CLEANUP => 1); |
---|
316 | |
---|
317 | # Make sure $tmpdir does not have a trailing / |
---|
318 | $tmpdir =~ s{/$}{}; |
---|
319 | $ENV{HOME} = $tmpdir; |
---|
320 | |
---|
321 | sub touch { |
---|
322 | my $path = shift; |
---|
323 | system("touch", "$path"); |
---|
324 | } |
---|
325 | |
---|
326 | mkpath(["$tmpdir/.owl/", |
---|
327 | "$tmpdir/.owl/modules/", |
---|
328 | "$tmpdir/Public/", |
---|
329 | "$tmpdir/Private/", |
---|
330 | "$tmpdir/.ours", |
---|
331 | "$tmpdir/www"], |
---|
332 | 0, 0700); |
---|
333 | touch("$tmpdir/.zephyr.subs"); |
---|
334 | touch("$tmpdir/wheee"); |
---|
335 | touch("$tmpdir/.owl/startup"); |
---|
336 | |
---|
337 | sub completion_value { |
---|
338 | my $c = shift; |
---|
339 | return $c unless ref($c) eq 'ARRAY'; |
---|
340 | return $c->[1]; |
---|
341 | } |
---|
342 | |
---|
343 | sub 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 | |
---|
365 | is_deeply([complete_file("~")], [["~/", "~/", 0]]); |
---|
366 | |
---|
367 | END { chdir("/"); } |
---|
368 | chdir($tmpdir); |
---|
369 | test_file("$tmpdir/", $tmpdir, |
---|
370 | [qw(Public Private www)], |
---|
371 | [qw(wheee)]); |
---|
372 | |
---|
373 | test_file("./", ".", |
---|
374 | [qw(Public Private www)], |
---|
375 | [qw(wheee)]); |
---|
376 | |
---|
377 | test_file("", undef, [qw(Public Private www)], [qw(wheee)]); |
---|
378 | |
---|
379 | test_file("./.owl/", "./.owl", |
---|
380 | [qw(modules)], |
---|
381 | [qw(startup)]); |
---|
382 | |
---|
383 | test_file("~/", "~", |
---|
384 | [qw(Public Private www)], |
---|
385 | [qw(wheee)]); |
---|
386 | |
---|
387 | test_file("P", undef, [qw(Public Private)], []); |
---|
388 | |
---|
389 | test_file("$tmpdir/.", $tmpdir, |
---|
390 | [qw(. .. .owl .ours)], |
---|
391 | [qw(.zephyr.subs)]); |
---|
392 | 1; |
---|
393 | |
---|