summaryrefslogtreecommitdiffstats
path: root/src/testdir/test_perl.vim
diff options
context:
space:
mode:
Diffstat (limited to 'src/testdir/test_perl.vim')
-rw-r--r--src/testdir/test_perl.vim356
1 files changed, 356 insertions, 0 deletions
diff --git a/src/testdir/test_perl.vim b/src/testdir/test_perl.vim
new file mode 100644
index 0000000..681aaae
--- /dev/null
+++ b/src/testdir/test_perl.vim
@@ -0,0 +1,356 @@
+" Tests for Perl interface
+
+source check.vim
+source shared.vim
+CheckFeature perl
+
+" FIXME: RunTest don't see any error when Perl abort...
+perl $SIG{__WARN__} = sub { die "Unexpected warnings from perl: @_" };
+
+func Test_change_buffer()
+ call setline(line('$'), ['1 line 1'])
+ perl VIM::DoCommand("normal /^1\n")
+ perl $curline = VIM::Eval("line('.')")
+ perl $curbuf->Set($curline, "1 changed line 1")
+ call assert_equal('1 changed line 1', getline('$'))
+endfunc
+
+func Test_evaluate_list()
+ call setline(line('$'), ['2 line 2'])
+ perl VIM::DoCommand("normal /^2\n")
+ perl $curline = VIM::Eval("line('.')")
+ let l = ["abc", "def"]
+ perl << EOF
+ $l = VIM::Eval("l");
+ $curbuf->Append($curline, $l);
+EOF
+ normal j
+ .perldo s|\n|/|g
+ call assert_equal('abc/def/', getline('$'))
+endfunc
+
+funct Test_VIM_Blob()
+ call assert_equal('0z', perleval('VIM::Blob("")'))
+ call assert_equal('0z31326162', 'VIM::Blob("12ab")'->perleval())
+ call assert_equal('0z00010203', perleval('VIM::Blob("\x00\x01\x02\x03")'))
+ call assert_equal('0z8081FEFF', perleval('VIM::Blob("\x80\x81\xfe\xff")'))
+endfunc
+
+func Test_buffer_Delete()
+ new
+ call setline(1, ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'])
+ perl $curbuf->Delete(7)
+ perl $curbuf->Delete(2, 5)
+ perl $curbuf->Delete(10)
+ call assert_equal(['a', 'f', 'h'], getline(1, '$'))
+ bwipe!
+endfunc
+
+func Test_buffer_Append()
+ new
+ perl $curbuf->Append(1, '1')
+ perl $curbuf->Append(2, '2', '3', '4')
+ perl @l = ('5' ..'7')
+ perl $curbuf->Append(0, @l)
+ call assert_equal(['5', '6', '7', '', '1', '2', '3', '4'], getline(1, '$'))
+
+ perl $curbuf->Append(0)
+ call assert_match('^Usage: VIBUF::Append(vimbuf, lnum, @lines) at .* line 1\.$',
+ \ GetMessages()[-1])
+
+ bwipe!
+endfunc
+
+func Test_buffer_Set()
+ new
+ call setline(1, ['1', '2', '3', '4', '5'])
+ perl $curbuf->Set(2, 'a', 'b', 'c')
+ perl $curbuf->Set(4, 'A', 'B', 'C')
+ call assert_equal(['1', 'a', 'b', 'A', 'B'], getline(1, '$'))
+
+ perl $curbuf->Set(0)
+ call assert_match('^Usage: VIBUF::Set(vimbuf, lnum, @lines) at .* line 1\.$',
+ \ GetMessages()[-1])
+
+ bwipe!
+endfunc
+
+func Test_buffer_Get()
+ new
+ call setline(1, ['1', '2', '3', '4'])
+ call assert_equal('2:3', perleval('join(":", $curbuf->Get(2, 3))'))
+ bwipe!
+endfunc
+
+func Test_buffer_Count()
+ new
+ call setline(1, ['a', 'b', 'c'])
+ call assert_equal(3, perleval('$curbuf->Count()'))
+ bwipe!
+endfunc
+
+func Test_buffer_Name()
+ new
+ call assert_equal('', perleval('$curbuf->Name()'))
+ bwipe!
+ new Xfoo
+ call assert_equal('Xfoo', perleval('$curbuf->Name()'))
+ bwipe!
+endfunc
+
+func Test_buffer_Number()
+ call assert_equal(bufnr('%'), perleval('$curbuf->Number()'))
+endfunc
+
+func Test_window_Cursor()
+ new
+ call setline(1, ['line1', 'line2'])
+ perl $curwin->Cursor(2, 3)
+ call assert_equal('2:3', perleval('join(":", $curwin->Cursor())'))
+ " Col is numbered from 0 in Perl, and from 1 in Vim script.
+ call assert_equal([0, 2, 4, 0], getpos('.'))
+ bwipe!
+endfunc
+
+func Test_window_SetHeight()
+ new
+ perl $curwin->SetHeight(2)
+ call assert_equal(2, winheight(0))
+ bwipe!
+endfunc
+
+func Test_VIM_Windows()
+ new
+ " VIM::Windows() without argument in scalar and list context.
+ perl $winnr = VIM::Windows()
+ perl @winlist = VIM::Windows()
+ perl $curbuf->Append(0, $winnr, scalar(@winlist))
+ call assert_equal(['2', '2', ''], getline(1, '$'))
+
+ " VIM::Windows() with window number argument.
+ perl VIM::Windows(VIM::Eval('winnr()'))->Buffer()->Set(1, 'bar')
+ call assert_equal('bar', getline(1))
+ bwipe!
+endfunc
+
+func Test_VIM_Buffers()
+ new Xbar
+ " VIM::Buffers() without argument in scalar and list context.
+ perl $nbuf = VIM::Buffers()
+ perl @buflist = VIM::Buffers()
+
+ " VIM::Buffers() with argument.
+ perl $mybuf = (VIM::Buffers('Xbar'))[0]
+ perl $mybuf->Append(0, $nbuf, scalar(@buflist))
+ call assert_equal(['2', '2', ''], getline(1, '$'))
+ bwipe!
+endfunc
+
+func <SID>catch_peval(expr)
+ try
+ call perleval(a:expr)
+ catch
+ return v:exception
+ endtry
+ call assert_report('no exception for `perleval("'.a:expr.'")`')
+ return ''
+endfunc
+
+func Test_perleval()
+ call assert_false(perleval('undef'))
+
+ " scalar
+ call assert_equal(0, perleval('0'))
+ call assert_equal(2, perleval('2'))
+ call assert_equal(-2, perleval('-2'))
+ call assert_equal(2.5, perleval('2.5'))
+
+ sandbox call assert_equal(2, perleval('2'))
+
+ call assert_equal('abc', perleval('"abc"'))
+ call assert_equal("abc\ndef", perleval('"abc\0def"'))
+
+ " ref
+ call assert_equal([], perleval('[]'))
+ call assert_equal(['word', 42, [42],{}], perleval('["word", 42, [42], {}]'))
+
+ call assert_equal({}, perleval('{}'))
+ call assert_equal({'foo': 'bar'}, perleval('{foo => "bar"}'))
+
+ perl our %h; our @a;
+ let a = perleval('[\(%h, %h, @a, @a)]')
+ call assert_true((a[0] is a[1]))
+ call assert_true((a[2] is a[3]))
+ perl undef %h; undef @a;
+
+ call assert_true(<SID>catch_peval('{"" , 0}') =~ 'Malformed key Dictionary')
+ call assert_true(<SID>catch_peval('{"\0" , 0}') =~ 'Malformed key Dictionary')
+ call assert_true(<SID>catch_peval('{"foo\0bar" , 0}') =~ 'Malformed key Dictionary')
+
+ call assert_equal('*VIM', perleval('"*VIM"'))
+ call assert_true(perleval('\\0') =~ 'SCALAR(0x\x\+)')
+
+ " typeglob
+ call assert_equal('*main::STDOUT', perleval('*STDOUT'))
+'
+ call perleval("++-$foo")
+ let messages = split(execute('message'), "\n")
+ call assert_match("Can't modify negation", messages[-1])
+endfunc
+
+func Test_perldo()
+ new
+ " :perldo in empty buffer does nothing.
+ perldo ++$counter
+ call assert_equal(0, perleval("$counter"))
+
+ sp __TEST__
+ exe 'read ' g:testname
+ perldo s/perl/vieux_chameau/g
+ 1
+ call assert_false(search('\Cperl'))
+ bw!
+
+ " Check deleting lines does not trigger ml_get error.
+ new
+ call setline(1, ['one', 'two', 'three'])
+ perldo VIM::DoCommand("%d_")
+ bwipe!
+
+ " Check a Perl expression which gives an error.
+ new
+ call setline(1, 'one')
+ perldo 1/0
+ call assert_match('^Illegal division by zero at .* line 1\.$', GetMessages()[-1])
+ bwipe!
+
+ " Check switching to another buffer does not trigger ml_get error.
+ new
+ let wincount = winnr('$')
+ call setline(1, ['one', 'two', 'three'])
+ perldo VIM::DoCommand("new")
+ call assert_equal(wincount + 1, winnr('$'))
+ %bwipe!
+endfunc
+
+func Test_VIM_package()
+ perl VIM::DoCommand('let l:var = "foo"')
+ call assert_equal(l:var, 'foo')
+
+ set noet
+ perl VIM::SetOption('et')
+ call assert_true(&et)
+endfunc
+
+func Test_stdio()
+ redir =>l:out
+ perl << trim EOF
+ VIM::Msg("VIM::Msg");
+ VIM::Msg("VIM::Msg Error", "Error");
+ print "STDOUT";
+ print STDERR "STDERR";
+ EOF
+ redir END
+ call assert_equal(['VIM::Msg', 'VIM::Msg Error', 'STDOUT', 'STDERR'], split(l:out, "\n"))
+endfunc
+
+" Run first to get a clean namespace
+func Test_000_SvREFCNT()
+ for i in range(8)
+ exec 'new X'.i
+ endfor
+ new t
+ perl <<--perl
+#line 5 "Test_000_SvREFCNT()"
+ my ($b, $w);
+
+ my $num = 0;
+ for ( 0 .. 100 ) {
+ if ( ++$num >= 8 ) { $num = 0 }
+ VIM::DoCommand("buffer X$num");
+ $b = $curbuf;
+ }
+
+ VIM::DoCommand("buffer t");
+
+ $b = $curbuf for 0 .. 100;
+ $w = $curwin for 0 .. 100;
+ () = VIM::Buffers for 0 .. 100;
+ () = VIM::Windows for 0 .. 100;
+
+ VIM::DoCommand('bw! t');
+ if (exists &Internals::SvREFCNT) {
+ my $cb = Internals::SvREFCNT($$b);
+ my $cw = Internals::SvREFCNT($$w);
+ VIM::Eval("assert_equal(2, $cb, 'T1')");
+ VIM::Eval("assert_equal(2, $cw, 'T2')");
+ my $strongref;
+ foreach ( VIM::Buffers, VIM::Windows ) {
+ VIM::DoCommand("%bw!");
+ my $c = Internals::SvREFCNT($_);
+ VIM::Eval("assert_equal(2, $c, 'T3')");
+ $c = Internals::SvREFCNT($$_);
+ next if $c == 2 && !$strongref++;
+ VIM::Eval("assert_equal(1, $c, 'T4')");
+ }
+ $cb = Internals::SvREFCNT($$curbuf);
+ $cw = Internals::SvREFCNT($$curwin);
+ VIM::Eval("assert_equal(3, $cb, 'T5')");
+ VIM::Eval("assert_equal(3, $cw, 'T6')");
+ }
+ VIM::Eval("assert_false($$b)");
+ VIM::Eval("assert_false($$w)");
+--perl
+ %bw!
+endfunc
+
+" This caused a memory error before issue #10386 was fixed
+func Test_stack_usage_fix()
+ let script =<< CODE
+ " This will grow Perl's stack in first invocation
+ eval [0, 0]->map({ -> perleval("push@_,0..4096;0") })
+ q!
+CODE
+ call RunVim([], script, '')
+endfunc
+
+func Test_set_cursor()
+ " Check that setting the cursor position works.
+ new
+ call setline(1, ['first line', 'second line'])
+ normal gg
+ perldo $curwin->Cursor(1, 5)
+ call assert_equal([1, 6], [line('.'), col('.')])
+
+ " Check that movement after setting cursor position keeps current column.
+ normal j
+ call assert_equal([2, 6], [line('.'), col('.')])
+endfunc
+
+" Test for various heredoc syntax
+func Test_perl_heredoc()
+ perl << END
+VIM::DoCommand('let s = "A"')
+END
+ perl <<
+VIM::DoCommand('let s ..= "B"')
+.
+ perl << trim END
+ VIM::DoCommand('let s ..= "C"')
+ END
+ perl << trim
+ VIM::DoCommand('let s ..= "D"')
+ .
+ perl << trim eof
+ VIM::DoCommand('let s ..= "E"')
+ eof
+ call assert_equal('ABCDE', s)
+endfunc
+
+func Test_perl_in_sandbox()
+ sandbox perl print 'test'
+ let messages = split(execute('message'), "\n")
+ call assert_match("'print' trapped by operation mask", messages[-1])
+endfunc
+
+" vim: shiftwidth=2 sts=2 expandtab
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-23 03:23:04 +0000