| 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 | =head1 DESCRIPTION |
|---|
| 11 | |
|---|
| 12 | Basic tests for tab-completion functionality. |
|---|
| 13 | |
|---|
| 14 | =cut |
|---|
| 15 | |
|---|
| 16 | sub 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 $words = shift; |
|---|
| 23 | my $word = shift; |
|---|
| 24 | my $word_point = shift; |
|---|
| 25 | |
|---|
| 26 | my $word_start = shift; |
|---|
| 27 | my $word_end = shift; |
|---|
| 28 | |
|---|
| 29 | my $ctx = BarnOwl::Completion::Context->new($before_point, |
|---|
| 30 | $after_point); |
|---|
| 31 | |
|---|
| 32 | is($ctx->line, $before_point . $after_point); |
|---|
| 33 | is($ctx->point, length $before_point); |
|---|
| 34 | is_deeply($ctx->words, $words); |
|---|
| 35 | if (defined($word)) { |
|---|
| 36 | is($ctx->word, $word, "Correct current word."); |
|---|
| 37 | is($ctx->word_point, $word_point, "Correct point within word."); |
|---|
| 38 | is($ctx->word_start, $word_start, "Correct start of word"); |
|---|
| 39 | is($ctx->word_end, $word_end, "Correct end of word"); |
|---|
| 40 | } |
|---|
| 41 | } |
|---|
| 42 | |
|---|
| 43 | |
|---|
| 44 | new_ok('BarnOwl::Completion::Context' => ['Hello, W', 'orld']); |
|---|
| 45 | |
|---|
| 46 | no warnings 'qw'; |
|---|
| 47 | test_tokenize('Hello, W', 'orld', |
|---|
| 48 | [qw(Hello, World)], 1, 1, 7, 12); |
|---|
| 49 | |
|---|
| 50 | test_tokenize('Hello, World', '', |
|---|
| 51 | [qw(Hello, World)], 1, 5, 7, 12); |
|---|
| 52 | |
|---|
| 53 | test_tokenize('', '', |
|---|
| 54 | [qw()], 0, 0, 0, 0); |
|---|
| 55 | |
|---|
| 56 | test_tokenize('Hello', 'World', |
|---|
| 57 | [qw(HelloWorld)], 0, 5, 0, 10); |
|---|
| 58 | |
|---|
| 59 | test_tokenize('lorem ipsum dolor ', 'sit amet', |
|---|
| 60 | [qw(lorem ipsum dolor sit amet)], |
|---|
| 61 | 3, 0, 18, 21); |
|---|
| 62 | |
|---|
| 63 | test_tokenize(q{error "ls -l failed"}, q{}, |
|---|
| 64 | ['error', 'ls -l failed'], |
|---|
| 65 | 1, 12, 6, 20); |
|---|
| 66 | |
|---|
| 67 | test_tokenize(q{"a long"' word'}, q{}, |
|---|
| 68 | ['a long word']); |
|---|
| 69 | |
|---|
| 70 | test_tokenize(q{"'"}, q{}, [q{'}], 0, 1, 0, 3); |
|---|
| 71 | |
|---|
| 72 | test_tokenize(q{"Hello, }, q{World"}, |
|---|
| 73 | [q{Hello, World}], |
|---|
| 74 | 0, 7, 0, 14); |
|---|
| 75 | |
|---|
| 76 | test_tokenize(q{But 'Hello, }, q{World'}, |
|---|
| 77 | ['But', q{Hello, World}], |
|---|
| 78 | 1, 7, 4, 18); |
|---|
| 79 | |
|---|
| 80 | test_tokenize(q{But "Hello, }, q{World"''''''""}, |
|---|
| 81 | ['But', q{Hello, World}], |
|---|
| 82 | 1, 7, 4, 26); |
|---|
| 83 | |
|---|
| 84 | test_tokenize(q{}, q{''Hello}, |
|---|
| 85 | ['Hello'], |
|---|
| 86 | 0, 0, 0, 7); |
|---|
| 87 | |
|---|
| 88 | test_tokenize(q{"Hello, }, q{World}, |
|---|
| 89 | [q{Hello, World}], |
|---|
| 90 | 0, 7, 0, 13); |
|---|
| 91 | |
|---|
| 92 | test_tokenize(q{Hello }, q{World}, |
|---|
| 93 | [qw{Hello World}], |
|---|
| 94 | 1, 0, 9, 14); |
|---|
| 95 | |
|---|
| 96 | test_tokenize(q{Hello '' ""}, q{ World}, |
|---|
| 97 | ["Hello", '', '', 'World'], |
|---|
| 98 | 2, 0, 9, 11); |
|---|
| 99 | |
|---|
| 100 | test_tokenize(q{zwrite -c }, q{}, |
|---|
| 101 | [qw(zwrite -c), ''], |
|---|
| 102 | 2, 0, 10, 10); |
|---|
| 103 | |
|---|
| 104 | # It's not entirely clear what we should do here. Make a test for the |
|---|
| 105 | # current behavior, so we'll notice if it changes. |
|---|
| 106 | test_tokenize(q{Hello }, q{ World}, |
|---|
| 107 | [qw(Hello World)], |
|---|
| 108 | 1, -1, 7, 12); |
|---|
| 109 | |
|---|
| 110 | |
|---|
| 111 | ## Test common_prefix |
|---|
| 112 | |
|---|
| 113 | is(BarnOwl::Completion::common_prefix(qw(a b)), ''); |
|---|
| 114 | is(BarnOwl::Completion::common_prefix(qw(a aa)), 'a'); |
|---|
| 115 | |
|---|
| 116 | is(BarnOwl::Completion::common_prefix(qw(aa)), 'aa'); |
|---|
| 117 | |
|---|
| 118 | is(BarnOwl::Completion::common_prefix(qw(a ab abc)), 'a'); |
|---|
| 119 | |
|---|
| 120 | is(BarnOwl::Completion::common_prefix(qw(abc abcd)), 'abc'); |
|---|
| 121 | |
|---|
| 122 | is(BarnOwl::Completion::common_prefix(qw(abc abc)), 'abc'); |
|---|
| 123 | |
|---|
| 124 | is(BarnOwl::Completion::common_prefix('a', ''), ''); |
|---|
| 125 | |
|---|
| 126 | ## Test complete_flags |
|---|
| 127 | |
|---|
| 128 | use BarnOwl::Completion::Util qw(complete_flags); |
|---|
| 129 | |
|---|
| 130 | # dummy complete_zwrite |
|---|
| 131 | sub complete_zwrite { |
|---|
| 132 | my $ctx = shift; |
|---|
| 133 | return complete_flags($ctx, |
|---|
| 134 | [qw(-n -C -m)], |
|---|
| 135 | { |
|---|
| 136 | "-c" => sub {qw(nelhage nethack sipb help)}, |
|---|
| 137 | "-i" => sub {qw()}, |
|---|
| 138 | "-r" => sub {qw(ATHENA.MIT.EDU ZONE.MIT.EDU ANDREW.CMU.EDU)}, |
|---|
| 139 | "-O" => sub {qw()}, |
|---|
| 140 | }, |
|---|
| 141 | sub {qw(nelhage asedeno geofft)}); |
|---|
| 142 | } |
|---|
| 143 | |
|---|
| 144 | sub test_complete { |
|---|
| 145 | my $before = shift; |
|---|
| 146 | my $after = shift; |
|---|
| 147 | my $words = shift; |
|---|
| 148 | my $complete = shift || \&complete_zwrite; |
|---|
| 149 | |
|---|
| 150 | my $ctx = BarnOwl::Completion::Context->new($before, $after); |
|---|
| 151 | |
|---|
| 152 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
|---|
| 153 | |
|---|
| 154 | my @got = $complete->($ctx); |
|---|
| 155 | is_deeply([sort @got], [sort @$words]); |
|---|
| 156 | } |
|---|
| 157 | |
|---|
| 158 | test_complete('zwrite -c ', '', [qw(nelhage nethack sipb help)]); |
|---|
| 159 | |
|---|
| 160 | test_complete('zwrite -c nelhage', '', [qw(nelhage nethack sipb help)]); |
|---|
| 161 | |
|---|
| 162 | test_complete('zwrite -c nelhage -i ', '', [qw()]); |
|---|
| 163 | |
|---|
| 164 | test_complete('zwrite -c nelhage ', '', |
|---|
| 165 | [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]); |
|---|
| 166 | |
|---|
| 167 | test_complete('zwrite -c nelhage ', '-', |
|---|
| 168 | [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]); |
|---|
| 169 | |
|---|
| 170 | test_complete('zwrite -c nelhage -- ', '', |
|---|
| 171 | [qw(nelhage asedeno geofft)]); |
|---|
| 172 | |
|---|
| 173 | sub complete_word { |
|---|
| 174 | my $ctx = shift; |
|---|
| 175 | return complete_flags($ctx, |
|---|
| 176 | [qw(-a -b -c)], |
|---|
| 177 | { |
|---|
| 178 | "-d" => sub {qw(some words for completing)}, |
|---|
| 179 | }, |
|---|
| 180 | sub {$_[1]}); |
|---|
| 181 | } |
|---|
| 182 | |
|---|
| 183 | test_complete('cmd -a -d foo -c hello ','', |
|---|
| 184 | [qw(-a -b -c -d 1)], \&complete_word); |
|---|
| 185 | |
|---|
| 186 | test_complete('cmd -a -d foo -c ','', |
|---|
| 187 | [qw(-a -b -c -d 0)], \&complete_word); |
|---|
| 188 | |
|---|
| 189 | 1; |
|---|
| 190 | |
|---|