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