1" Tests for Perl interface 2 3source check.vim 4source shared.vim 5CheckFeature perl 6 7" FIXME: RunTest don't see any error when Perl abort... 8perl $SIG{__WARN__} = sub { die "Unexpected warnings from perl: @_" }; 9 10func Test_change_buffer() 11 call setline(line('$'), ['1 line 1']) 12 perl VIM::DoCommand("normal /^1\n") 13 perl $curline = VIM::Eval("line('.')") 14 perl $curbuf->Set($curline, "1 changed line 1") 15 call assert_equal('1 changed line 1', getline('$')) 16endfunc 17 18func Test_evaluate_list() 19 call setline(line('$'), ['2 line 2']) 20 perl VIM::DoCommand("normal /^2\n") 21 perl $curline = VIM::Eval("line('.')") 22 let l = ["abc", "def"] 23 perl << EOF 24 $l = VIM::Eval("l"); 25 $curbuf->Append($curline, $l); 26EOF 27 normal j 28 .perldo s|\n|/|g 29 call assert_equal('abc/def/', getline('$')) 30endfunc 31 32funct Test_VIM_Blob() 33 call assert_equal('0z', perleval('VIM::Blob("")')) 34 call assert_equal('0z31326162', 'VIM::Blob("12ab")'->perleval()) 35 call assert_equal('0z00010203', perleval('VIM::Blob("\x00\x01\x02\x03")')) 36 call assert_equal('0z8081FEFF', perleval('VIM::Blob("\x80\x81\xfe\xff")')) 37endfunc 38 39func Test_buffer_Delete() 40 new 41 call setline(1, ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h']) 42 perl $curbuf->Delete(7) 43 perl $curbuf->Delete(2, 5) 44 perl $curbuf->Delete(10) 45 call assert_equal(['a', 'f', 'h'], getline(1, '$')) 46 bwipe! 47endfunc 48 49func Test_buffer_Append() 50 new 51 perl $curbuf->Append(1, '1') 52 perl $curbuf->Append(2, '2', '3', '4') 53 perl @l = ('5' ..'7') 54 perl $curbuf->Append(0, @l) 55 call assert_equal(['5', '6', '7', '', '1', '2', '3', '4'], getline(1, '$')) 56 57 perl $curbuf->Append(0) 58 call assert_match('^Usage: VIBUF::Append(vimbuf, lnum, @lines) at .* line 1\.$', 59 \ GetMessages()[-1]) 60 61 bwipe! 62endfunc 63 64func Test_buffer_Set() 65 new 66 call setline(1, ['1', '2', '3', '4', '5']) 67 perl $curbuf->Set(2, 'a', 'b', 'c') 68 perl $curbuf->Set(4, 'A', 'B', 'C') 69 call assert_equal(['1', 'a', 'b', 'A', 'B'], getline(1, '$')) 70 71 perl $curbuf->Set(0) 72 call assert_match('^Usage: VIBUF::Set(vimbuf, lnum, @lines) at .* line 1\.$', 73 \ GetMessages()[-1]) 74 75 bwipe! 76endfunc 77 78func Test_buffer_Get() 79 new 80 call setline(1, ['1', '2', '3', '4']) 81 call assert_equal('2:3', perleval('join(":", $curbuf->Get(2, 3))')) 82 bwipe! 83endfunc 84 85func Test_buffer_Count() 86 new 87 call setline(1, ['a', 'b', 'c']) 88 call assert_equal(3, perleval('$curbuf->Count()')) 89 bwipe! 90endfunc 91 92func Test_buffer_Name() 93 new 94 call assert_equal('', perleval('$curbuf->Name()')) 95 bwipe! 96 new Xfoo 97 call assert_equal('Xfoo', perleval('$curbuf->Name()')) 98 bwipe! 99endfunc 100 101func Test_buffer_Number() 102 call assert_equal(bufnr('%'), perleval('$curbuf->Number()')) 103endfunc 104 105func Test_window_Cursor() 106 new 107 call setline(1, ['line1', 'line2']) 108 perl $curwin->Cursor(2, 3) 109 call assert_equal('2:3', perleval('join(":", $curwin->Cursor())')) 110 " Col is numbered from 0 in Perl, and from 1 in Vim script. 111 call assert_equal([0, 2, 4, 0], getpos('.')) 112 bwipe! 113endfunc 114 115func Test_window_SetHeight() 116 new 117 perl $curwin->SetHeight(2) 118 call assert_equal(2, winheight(0)) 119 bwipe! 120endfunc 121 122func Test_VIM_Windows() 123 new 124 " VIM::Windows() without argument in scalar and list context. 125 perl $winnr = VIM::Windows() 126 perl @winlist = VIM::Windows() 127 perl $curbuf->Append(0, $winnr, scalar(@winlist)) 128 call assert_equal(['2', '2', ''], getline(1, '$')) 129 130 " VIM::Windows() with window number argument. 131 perl VIM::Windows(VIM::Eval('winnr()'))->Buffer()->Set(1, 'bar') 132 call assert_equal('bar', getline(1)) 133 bwipe! 134endfunc 135 136func Test_VIM_Buffers() 137 new Xbar 138 " VIM::Buffers() without argument in scalar and list context. 139 perl $nbuf = VIM::Buffers() 140 perl @buflist = VIM::Buffers() 141 142 " VIM::Buffers() with argument. 143 perl $mybuf = (VIM::Buffers('Xbar'))[0] 144 perl $mybuf->Append(0, $nbuf, scalar(@buflist)) 145 call assert_equal(['2', '2', ''], getline(1, '$')) 146 bwipe! 147endfunc 148 149func <SID>catch_peval(expr) 150 try 151 call perleval(a:expr) 152 catch 153 return v:exception 154 endtry 155 call assert_report('no exception for `perleval("'.a:expr.'")`') 156 return '' 157endfunc 158 159func Test_perleval() 160 call assert_false(perleval('undef')) 161 162 " scalar 163 call assert_equal(0, perleval('0')) 164 call assert_equal(2, perleval('2')) 165 call assert_equal(-2, perleval('-2')) 166 if has('float') 167 call assert_equal(2.5, perleval('2.5')) 168 else 169 call assert_equal(2, perleval('2.5')) 170 end 171 172 sandbox call assert_equal(2, perleval('2')) 173 174 call assert_equal('abc', perleval('"abc"')) 175 call assert_equal("abc\ndef", perleval('"abc\0def"')) 176 177 " ref 178 call assert_equal([], perleval('[]')) 179 call assert_equal(['word', 42, [42],{}], perleval('["word", 42, [42], {}]')) 180 181 call assert_equal({}, perleval('{}')) 182 call assert_equal({'foo': 'bar'}, perleval('{foo => "bar"}')) 183 184 perl our %h; our @a; 185 let a = perleval('[\(%h, %h, @a, @a)]') 186 call assert_true((a[0] is a[1])) 187 call assert_true((a[2] is a[3])) 188 perl undef %h; undef @a; 189 190 call assert_true(<SID>catch_peval('{"" , 0}') =~ 'Malformed key Dictionary') 191 call assert_true(<SID>catch_peval('{"\0" , 0}') =~ 'Malformed key Dictionary') 192 call assert_true(<SID>catch_peval('{"foo\0bar" , 0}') =~ 'Malformed key Dictionary') 193 194 call assert_equal('*VIM', perleval('"*VIM"')) 195 call assert_true(perleval('\\0') =~ 'SCALAR(0x\x\+)') 196 197 " typeglob 198 call assert_equal('*main::STDOUT', perleval('*STDOUT')) 199' 200 call perleval("++-$foo") 201 let messages = split(execute('message'), "\n") 202 call assert_match("Can't modify negation", messages[-1]) 203endfunc 204 205func Test_perldo() 206 new 207 " :perldo in empty buffer does nothing. 208 perldo ++$counter 209 call assert_equal(0, perleval("$counter")) 210 211 sp __TEST__ 212 exe 'read ' g:testname 213 perldo s/perl/vieux_chameau/g 214 1 215 call assert_false(search('\Cperl')) 216 bw! 217 218 " Check deleting lines does not trigger ml_get error. 219 new 220 call setline(1, ['one', 'two', 'three']) 221 perldo VIM::DoCommand("%d_") 222 bwipe! 223 224 " Check a Perl expression which gives an error. 225 new 226 call setline(1, 'one') 227 perldo 1/0 228 call assert_match('^Illegal division by zero at .* line 1\.$', GetMessages()[-1]) 229 bwipe! 230 231 " Check switching to another buffer does not trigger ml_get error. 232 new 233 let wincount = winnr('$') 234 call setline(1, ['one', 'two', 'three']) 235 perldo VIM::DoCommand("new") 236 call assert_equal(wincount + 1, winnr('$')) 237 %bwipe! 238endfunc 239 240func Test_VIM_package() 241 perl VIM::DoCommand('let l:var = "foo"') 242 call assert_equal(l:var, 'foo') 243 244 set noet 245 perl VIM::SetOption('et') 246 call assert_true(&et) 247endfunc 248 249func Test_stdio() 250 redir =>l:out 251 perl << trim EOF 252 VIM::Msg("VIM::Msg"); 253 VIM::Msg("VIM::Msg Error", "Error"); 254 print "STDOUT"; 255 print STDERR "STDERR"; 256 EOF 257 redir END 258 call assert_equal(['VIM::Msg', 'VIM::Msg Error', 'STDOUT', 'STDERR'], split(l:out, "\n")) 259endfunc 260 261" Run first to get a clean namespace 262func Test_000_SvREFCNT() 263 for i in range(8) 264 exec 'new X'.i 265 endfor 266 new t 267 perl <<--perl 268#line 5 "Test_000_SvREFCNT()" 269 my ($b, $w); 270 271 my $num = 0; 272 for ( 0 .. 100 ) { 273 if ( ++$num >= 8 ) { $num = 0 } 274 VIM::DoCommand("buffer X$num"); 275 $b = $curbuf; 276 } 277 278 VIM::DoCommand("buffer t"); 279 280 $b = $curbuf for 0 .. 100; 281 $w = $curwin for 0 .. 100; 282 () = VIM::Buffers for 0 .. 100; 283 () = VIM::Windows for 0 .. 100; 284 285 VIM::DoCommand('bw! t'); 286 if (exists &Internals::SvREFCNT) { 287 my $cb = Internals::SvREFCNT($$b); 288 my $cw = Internals::SvREFCNT($$w); 289 VIM::Eval("assert_equal(2, $cb, 'T1')"); 290 VIM::Eval("assert_equal(2, $cw, 'T2')"); 291 my $strongref; 292 foreach ( VIM::Buffers, VIM::Windows ) { 293 VIM::DoCommand("%bw!"); 294 my $c = Internals::SvREFCNT($_); 295 VIM::Eval("assert_equal(2, $c, 'T3')"); 296 $c = Internals::SvREFCNT($$_); 297 next if $c == 2 && !$strongref++; 298 VIM::Eval("assert_equal(1, $c, 'T4')"); 299 } 300 $cb = Internals::SvREFCNT($$curbuf); 301 $cw = Internals::SvREFCNT($$curwin); 302 VIM::Eval("assert_equal(3, $cb, 'T5')"); 303 VIM::Eval("assert_equal(3, $cw, 'T6')"); 304 } 305 VIM::Eval("assert_false($$b)"); 306 VIM::Eval("assert_false($$w)"); 307--perl 308 %bw! 309endfunc 310 311func Test_set_cursor() 312 " Check that setting the cursor position works. 313 new 314 call setline(1, ['first line', 'second line']) 315 normal gg 316 perldo $curwin->Cursor(1, 5) 317 call assert_equal([1, 6], [line('.'), col('.')]) 318 319 " Check that movement after setting cursor position keeps current column. 320 normal j 321 call assert_equal([2, 6], [line('.'), col('.')]) 322endfunc 323 324" Test for various heredoc syntax 325func Test_perl_heredoc() 326 perl << END 327VIM::DoCommand('let s = "A"') 328END 329 perl << 330VIM::DoCommand('let s ..= "B"') 331. 332 perl << trim END 333 VIM::DoCommand('let s ..= "C"') 334 END 335 perl << trim 336 VIM::DoCommand('let s ..= "D"') 337 . 338 perl << trim eof 339 VIM::DoCommand('let s ..= "E"') 340 eof 341 call assert_equal('ABCDE', s) 342endfunc 343 344func Test_perl_in_sandbox() 345 sandbox perl print 'test' 346 let messages = split(execute('message'), "\n") 347 call assert_match("'print' trapped by operation mask", messages[-1]) 348endfunc 349 350" vim: shiftwidth=2 sts=2 expandtab 351