source: t/completion.t @ e4f4287

release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since e4f4287 was e4f4287, checked in by David Benjamin <davidben@mit.edu>, 12 years ago
Enable Context::shift_words tests and add one Now that the tester can run XS code, we can test shift_words. Also added a new test that ensures we die when we shift away the point. Signed-off-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 6.8 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
10=head1 DESCRIPTION
11
12Basic tests for tab-completion functionality.
13
14=cut
15
16sub test_tokenize {
17    local $Test::Builder::Level = $Test::Builder::Level + 1;
18
19    my $before_point = shift;
20    my $after_point = shift;
21   
22    my $ctx = BarnOwl::Completion::Context->new($before_point,
23                                                $after_point);
24    is($ctx->line, $before_point . $after_point);
25    is($ctx->point, length $before_point);
26
27    test_ctx($ctx, @_);
28}
29
30sub test_ctx {
31    local $Test::Builder::Level = $Test::Builder::Level + 1;
32
33    my $ctx = shift;
34
35    my $words = shift;
36    my $word = shift;
37    my $word_point = shift;
38
39    my $word_start = shift;
40    my $word_end   = shift;
41
42    is_deeply($ctx->words, $words);
43    if (defined($word)) {
44        is($ctx->word, $word, "Correct current word.");
45        is($ctx->word_point, $word_point, "Correct point within word.");
46        is($ctx->word_start, $word_start, "Correct start of word");
47        is($ctx->word_end,   $word_end, "Correct end of word");
48    }
49}
50
51sub test_shift {
52    local $Test::Builder::Level = $Test::Builder::Level + 1;
53
54    my $before_point = shift;
55    my $after_point = shift;
56    my $shift = shift;
57   
58    my $ctx = BarnOwl::Completion::Context->new($before_point,
59                                                $after_point);
60    $ctx = $ctx->shift_words($shift);
61
62    test_ctx($ctx, @_);
63}
64
65
66isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context');
67
68no warnings 'qw';
69test_tokenize('Hello, W', 'orld',
70              [qw(Hello, World)], 1, 1, 7, 12);
71
72test_tokenize('Hello, World', '',
73              [qw(Hello, World)], 1, 5, 7, 12);
74
75test_tokenize('', '',
76              [qw()], 0, 0, 0, 0);
77
78test_tokenize('Hello', 'World',
79              [qw(HelloWorld)], 0, 5, 0, 10);
80
81test_tokenize('lorem ipsum dolor ', 'sit amet',
82              [qw(lorem ipsum dolor sit amet)],
83              3, 0, 18, 21);
84
85test_tokenize(q{error "ls -l failed"}, q{},
86              ['error', 'ls -l failed'],
87              1, 12, 6, 20);
88
89test_tokenize(q{"a long"' word'}, q{},
90              ['a long word']);
91
92test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3);
93
94test_tokenize(q{"Hello, }, q{World"},
95              [q{Hello, World}],
96              0, 7, 0, 14);
97
98test_tokenize(q{But 'Hello, }, q{World'},
99              ['But', q{Hello, World}],
100              1, 7, 4, 18);
101
102test_tokenize(q{But "Hello, }, q{World"''''''""},
103              ['But', q{Hello, World}],
104              1, 7, 4, 26);
105
106test_tokenize(q{}, q{''Hello},
107              ['Hello'],
108              0, 0, 0, 7);
109
110test_tokenize(q{"Hello, }, q{World},
111              [q{Hello, World}],
112              0, 7, 0, 13);
113
114test_tokenize(q{Hello    }, q{World},
115              [qw{Hello World}],
116              1, 0, 9, 14);
117
118test_tokenize(q{Hello '' ""}, q{ World},
119              ["Hello", '', '', 'World'],
120              2, 0, 9, 11);
121
122test_tokenize(q{zwrite -c }, q{},
123              [qw(zwrite -c), ''],
124              2, 0, 10, 10);
125
126# It's not entirely clear what we should do here. Make a test for the
127# current behavior, so we'll notice if it changes.
128test_tokenize(q{Hello }, q{ World},
129              [qw(Hello World)],
130              1, -1, 7, 12);
131
132## Test Context::shift
133test_shift('lorem ipsum dolor ', 'sit amet', 0,
134           [qw(lorem ipsum dolor sit amet)],
135           3, 0, 18, 21);
136
137test_shift('lorem ipsum dolor ', 'sit amet', 1,
138           [qw(ipsum dolor sit amet)],
139           2, 0, 12, 15);
140
141test_shift('lorem ipsum dolor ', 'sit amet', 2,
142           [qw(dolor sit amet)],
143           1, 0, 6, 9);
144
145test_shift('lorem ipsum dolor ', 'sit amet', 3,
146           [qw(sit amet)],
147           0, 0, 0, 3);
148
149eval {
150    my $before_point = 'lorem ipsum dolor';
151    my $after_point = 'sit amet';
152    my $shift = 4;
153
154    my $ctx = BarnOwl::Completion::Context->new($before_point,
155                                                $after_point);
156    $ctx = $ctx->shift_words($shift);
157};
158like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point");
159
160## Test common_prefix
161
162is(BarnOwl::Completion::common_prefix(qw(a b)), '');
163is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a');
164
165is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa');
166
167is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a');
168
169is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc');
170
171is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc');
172
173is(BarnOwl::Completion::common_prefix('a', ''), '');
174
175## Test complete_flags
176
177use BarnOwl::Completion::Util qw(complete_flags);
178
179# dummy complete_zwrite
180sub complete_zwrite {
181    my $ctx = shift;
182    return complete_flags($ctx,
183                          [qw(-n -C -m)],
184                          {
185                              "-c" => sub {qw(nelhage nethack sipb help)},
186                              "-i" => sub {qw()},
187                              "-r" => sub {qw(ATHENA.MIT.EDU ZONE.MIT.EDU ANDREW.CMU.EDU)},
188                              "-O" => sub {qw()},
189                          },
190                          sub {qw(nelhage asedeno geofft)});
191}
192
193sub test_complete {
194    my $before = shift;
195    my $after = shift;
196    my $words = shift;
197    my $complete = shift || \&complete_zwrite;
198   
199    my $ctx = BarnOwl::Completion::Context->new($before, $after);
200
201    local $Test::Builder::Level = $Test::Builder::Level + 1;
202
203    my @got = $complete->($ctx);
204    is_deeply([sort @got], [sort @$words]);
205}
206
207test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]);
208
209test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]);
210
211test_complete('zwrite -c nelhage -i ', '', [qw()]);
212
213test_complete('zwrite -c nelhage ', '',
214              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
215
216test_complete('zwrite -c nelhage ', '-',
217              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
218
219test_complete('zwrite -c nelhage -- ', '',
220              [qw(nelhage asedeno geofft)]);
221
222sub complete_word {
223    my $ctx = shift;
224    return complete_flags($ctx,
225                          [qw(-a -b -c)],
226                          {
227                              "-d" => sub {qw(some words for completing)},
228                          },
229                          sub {$_[1]},
230                          repeat_flags => 1);
231}
232
233test_complete('cmd -a -d foo -c hello ','',
234              [qw(-a -b -c -d 1)], \&complete_word);
235
236test_complete('cmd -a -d foo -c ','',
237              [qw(-a -b -c -d 0)], \&complete_word);
238
239# Test that words after -- are counted properly.
240test_complete('cmd -- hi there ','',
241              [qw(2)], \&complete_word);
242
243test_complete('cmd --','',
244              [qw(-a -b -c -d 0)], \&complete_word);
245
246test_complete('cmd -- ','',
247              [qw(0)], \&complete_word);
248
249test_complete('cmd foo -- ','',
250              [qw(1)], \&complete_word);
251
252test_complete('cmd foo -- bar ','',
253              [qw(2)], \&complete_word);
254
2551;
256
Note: See TracBrowser for help on using the repository browser.