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 | BEGIN {require (dirname($0) . "/mock.pl");}; |
---|
9 | |
---|
10 | use BarnOwl::Complete::Filter qw(complete_filter_expr); |
---|
11 | |
---|
12 | =head1 DESCRIPTION |
---|
13 | |
---|
14 | Basic tests for tab-completion functionality. |
---|
15 | |
---|
16 | =cut |
---|
17 | |
---|
18 | sub 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 | |
---|
32 | sub 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 | |
---|
53 | sub 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 | |
---|
68 | isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context'); |
---|
69 | |
---|
70 | no warnings 'qw'; |
---|
71 | test_tokenize('Hello, W', 'orld', |
---|
72 | [qw(Hello, World)], 1, 1, 7, 12); |
---|
73 | |
---|
74 | test_tokenize('Hello, World', '', |
---|
75 | [qw(Hello, World)], 1, 5, 7, 12); |
---|
76 | |
---|
77 | test_tokenize('', '', |
---|
78 | [qw()], 0, 0, 0, 0); |
---|
79 | |
---|
80 | test_tokenize('Hello', 'World', |
---|
81 | [qw(HelloWorld)], 0, 5, 0, 10); |
---|
82 | |
---|
83 | test_tokenize('lorem ipsum dolor ', 'sit amet', |
---|
84 | [qw(lorem ipsum dolor sit amet)], |
---|
85 | 3, 0, 18, 21); |
---|
86 | |
---|
87 | test_tokenize(q{error "ls -l failed"}, q{}, |
---|
88 | ['error', 'ls -l failed'], |
---|
89 | 1, 12, 6, 20); |
---|
90 | |
---|
91 | test_tokenize(q{"a long"' word'}, q{}, |
---|
92 | ['a long word']); |
---|
93 | |
---|
94 | test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3); |
---|
95 | |
---|
96 | test_tokenize(q{"Hello, }, q{World"}, |
---|
97 | [q{Hello, World}], |
---|
98 | 0, 7, 0, 14); |
---|
99 | |
---|
100 | test_tokenize(q{But 'Hello, }, q{World'}, |
---|
101 | ['But', q{Hello, World}], |
---|
102 | 1, 7, 4, 18); |
---|
103 | |
---|
104 | test_tokenize(q{But "Hello, }, q{World"''''''""}, |
---|
105 | ['But', q{Hello, World}], |
---|
106 | 1, 7, 4, 26); |
---|
107 | |
---|
108 | test_tokenize(q{}, q{''Hello}, |
---|
109 | ['Hello'], |
---|
110 | 0, 0, 0, 7); |
---|
111 | |
---|
112 | test_tokenize(q{"Hello, }, q{World}, |
---|
113 | [q{Hello, World}], |
---|
114 | 0, 7, 0, 13); |
---|
115 | |
---|
116 | test_tokenize(q{Hello }, q{World}, |
---|
117 | [qw{Hello World}], |
---|
118 | 1, 0, 9, 14); |
---|
119 | |
---|
120 | test_tokenize(q{Hello '' ""}, q{ World}, |
---|
121 | ["Hello", '', '', 'World'], |
---|
122 | 2, 0, 9, 11); |
---|
123 | |
---|
124 | test_tokenize(q{zwrite -c }, q{}, |
---|
125 | [qw(zwrite -c), ''], |
---|
126 | 2, 0, 10, 10); |
---|
127 | |
---|
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. |
---|
130 | test_tokenize(q{Hello }, q{ World}, |
---|
131 | [qw(Hello World)], |
---|
132 | 1, -1, 7, 12); |
---|
133 | |
---|
134 | ## Test Context::shift |
---|
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(ipsum dolor sit amet)], |
---|
141 | 2, 0, 12, 15); |
---|
142 | |
---|
143 | test_shift('lorem ipsum dolor ', 'sit amet', 2, |
---|
144 | [qw(dolor sit amet)], |
---|
145 | 1, 0, 6, 9); |
---|
146 | |
---|
147 | test_shift('lorem ipsum dolor ', 'sit amet', 3, |
---|
148 | [qw(sit amet)], |
---|
149 | 0, 0, 0, 3); |
---|
150 | |
---|
151 | eval { |
---|
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 | }; |
---|
160 | like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point"); |
---|
161 | |
---|
162 | ## Test common_prefix |
---|
163 | |
---|
164 | is(BarnOwl::Completion::common_prefix(qw(a b)), ''); |
---|
165 | is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a'); |
---|
166 | |
---|
167 | is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa'); |
---|
168 | |
---|
169 | is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a'); |
---|
170 | |
---|
171 | is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc'); |
---|
172 | |
---|
173 | is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc'); |
---|
174 | |
---|
175 | is(BarnOwl::Completion::common_prefix('a', ''), ''); |
---|
176 | |
---|
177 | ## Test complete_flags |
---|
178 | |
---|
179 | use BarnOwl::Completion::Util qw(complete_flags); |
---|
180 | |
---|
181 | # dummy complete_zwrite |
---|
182 | sub 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 | |
---|
195 | sub test_complete { |
---|
196 | my $before = shift; |
---|
197 | my $after = shift; |
---|
198 | my $words = shift; |
---|
199 | my $complete = shift || \&complete_zwrite; |
---|
200 | |
---|
201 | my $ctx = BarnOwl::Completion::Context->new($before, $after); |
---|
202 | |
---|
203 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
---|
204 | |
---|
205 | my @got = $complete->($ctx); |
---|
206 | is_deeply([sort @got], [sort @$words]); |
---|
207 | } |
---|
208 | |
---|
209 | test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]); |
---|
210 | |
---|
211 | test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]); |
---|
212 | |
---|
213 | test_complete('zwrite -c nelhage -i ', '', [qw()]); |
---|
214 | |
---|
215 | test_complete('zwrite -c nelhage ', '', |
---|
216 | [qw(-n -C -m -i -r -O nelhage asedeno geofft)]); |
---|
217 | |
---|
218 | test_complete('zwrite -c nelhage ', '-', |
---|
219 | [qw(-n -C -m -i -r -O nelhage asedeno geofft)]); |
---|
220 | |
---|
221 | test_complete('zwrite -c nelhage -- ', '', |
---|
222 | [qw(nelhage asedeno geofft)]); |
---|
223 | |
---|
224 | sub 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 | }, |
---|
231 | sub {$_[1]}, |
---|
232 | repeat_flags => 1); |
---|
233 | } |
---|
234 | |
---|
235 | test_complete('cmd -a -d foo -c hello ','', |
---|
236 | [qw(-a -b -c -d 1)], \&complete_word); |
---|
237 | |
---|
238 | test_complete('cmd -a -d foo -c ','', |
---|
239 | [qw(-a -b -c -d 0)], \&complete_word); |
---|
240 | |
---|
241 | # Test that words after -- are counted properly. |
---|
242 | test_complete('cmd -- hi there ','', |
---|
243 | [qw(2)], \&complete_word); |
---|
244 | |
---|
245 | test_complete('cmd --','', |
---|
246 | [qw(-a -b -c -d 0)], \&complete_word); |
---|
247 | |
---|
248 | test_complete('cmd -- ','', |
---|
249 | [qw(0)], \&complete_word); |
---|
250 | |
---|
251 | test_complete('cmd foo -- ','', |
---|
252 | [qw(1)], \&complete_word); |
---|
253 | |
---|
254 | test_complete('cmd foo -- bar ','', |
---|
255 | [qw(2)], \&complete_word); |
---|
256 | |
---|
257 | |
---|
258 | # Test the filter expression completer |
---|
259 | test_complete('', '', |
---|
260 | [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]], |
---|
261 | \&complete_filter_expr); |
---|
262 | |
---|
263 | test_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 | |
---|
267 | test_complete('true ', '', |
---|
268 | [qw[and or]], |
---|
269 | \&complete_filter_expr); |
---|
270 | |
---|
271 | test_complete('( true ', '', |
---|
272 | [qw[and or )]], |
---|
273 | \&complete_filter_expr); |
---|
274 | |
---|
275 | test_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 | |
---|
279 | test_complete('type ', '', |
---|
280 | [qw[admin aim zephyr]], |
---|
281 | \&complete_filter_expr); |
---|
282 | |
---|
283 | test_complete('direction ', '', |
---|
284 | [qw[in out none]], |
---|
285 | \&complete_filter_expr); |
---|
286 | |
---|
287 | test_complete('login ', '', |
---|
288 | [qw[login logout none]], |
---|
289 | \&complete_filter_expr); |
---|
290 | |
---|
291 | # Test complete_files |
---|
292 | use BarnOwl::Completion::Util qw(complete_file); |
---|
293 | use File::Temp; |
---|
294 | use File::Path qw(mkpath); |
---|
295 | |
---|
296 | my $tmpdir = File::Temp::tempdir(CLEANUP => 1); |
---|
297 | |
---|
298 | # Make sure $tmpdir does not have a trailing / |
---|
299 | $tmpdir =~ s{/$}{}; |
---|
300 | $ENV{HOME} = $tmpdir; |
---|
301 | |
---|
302 | sub touch { |
---|
303 | my $path = shift; |
---|
304 | system("touch", "$path"); |
---|
305 | } |
---|
306 | |
---|
307 | mkpath("$tmpdir/.owl/", |
---|
308 | "$tmpdir/.owl/modules/", |
---|
309 | "$tmpdir/Public/", |
---|
310 | "$tmpdir/Private/", |
---|
311 | "$tmpdir/.ours", |
---|
312 | "$tmpdir/www"); |
---|
313 | touch("$tmpdir/.zephyr.subs"); |
---|
314 | touch("$tmpdir/wheee"); |
---|
315 | touch("$tmpdir/.owl/startup"); |
---|
316 | |
---|
317 | sub completion_value { |
---|
318 | my $c = shift; |
---|
319 | return $c unless ref($c) eq 'ARRAY'; |
---|
320 | return $c->[1]; |
---|
321 | } |
---|
322 | |
---|
323 | sub test_file { |
---|
324 | my $spec = shift; |
---|
325 | my $pfx = shift; |
---|
326 | my $dirs = shift; |
---|
327 | my $files = shift; |
---|
328 | |
---|
329 | my $expect = [ sort {$a->[1] cmp $b->[1]} |
---|
330 | ((map {["$_/", defined($pfx)?"$pfx/$_/":"$_/", 0]} @$dirs), |
---|
331 | (map {["$_", defined($pfx)?"$pfx/$_" :$_ , 1]} @$files)) |
---|
332 | ]; |
---|
333 | |
---|
334 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
---|
335 | |
---|
336 | my @got = complete_file($spec); |
---|
337 | |
---|
338 | @got = grep {completion_value($_) =~ m{^\Q$spec\E}} @got; |
---|
339 | @got = sort {completion_value($a) cmp completion_value($b)} @got; |
---|
340 | |
---|
341 | use Data::Dumper; |
---|
342 | is_deeply(\@got, $expect); |
---|
343 | } |
---|
344 | |
---|
345 | is_deeply([complete_file("~")], [["~/", "~/", 0]]); |
---|
346 | |
---|
347 | chdir($tmpdir); |
---|
348 | test_file("$tmpdir/", $tmpdir, |
---|
349 | [qw(Public Private www)], |
---|
350 | [qw(wheee)]); |
---|
351 | |
---|
352 | test_file("./", ".", |
---|
353 | [qw(Public Private www)], |
---|
354 | [qw(wheee)]); |
---|
355 | |
---|
356 | test_file("", undef, [qw(Public Private www)], [qw(wheee)]); |
---|
357 | |
---|
358 | test_file("./.owl/", "./.owl", |
---|
359 | [qw(modules)], |
---|
360 | [qw(startup)]); |
---|
361 | |
---|
362 | test_file("~/", "~", |
---|
363 | [qw(Public Private www)], |
---|
364 | [qw(wheee)]); |
---|
365 | |
---|
366 | test_file("P", undef, [qw(Public Private)], []); |
---|
367 | |
---|
368 | test_file("$tmpdir/.", $tmpdir, |
---|
369 | [qw(. .. .owl .ours)], |
---|
370 | [qw(.zephyr.subs)]); |
---|
371 | 1; |
---|
372 | |
---|