Support for :perl, :perlfile, :perldo and perleval() (#12809)

* support for :perl, :perlfile, :perldo and perleval()

* document that the perl provider doesn't currently work on Windows

* document that the perl legacy interface is now also supported

* added perleval() documentation

* import legacy perl interface tests

* only perl 5.22+ is supported

* healtcheck: use g:perl_host_prog if its set instead

using just 'perl' isn't correct as it may not be the version requested.
ditto for 'cpanm', rather go through 'App::cpanminus' to find the latest
perl version

5 files changed, 257 insertions, 2 deletions

diff --git a/src/nvim/eval.lua b/src/nvim/eval.lua
index be16ddd7f6..372c950825 100644
--- a/src/nvim/eval.lua
+++ b/src/nvim/eval.lua
@@ -256,6 +256,7 @@ return {
     py3eval={args=1},
     pyeval={args=1},
     pyxeval={args=1},
+    perleval={args=1},
     range={args={1, 3}},
     readdir={args={1, 2}},
     readfile={args={1, 3}},
diff --git a/src/nvim/eval/funcs.c b/src/nvim/eval/funcs.c
index ac560124bf..f4d9db53c4 100644
--- a/src/nvim/eval/funcs.c
+++ b/src/nvim/eval/funcs.c
@@ -6374,6 +6374,14 @@ static void f_pyxeval(typval_T *argvars, typval_T *rettv, FunPtr fptr)
   }
 }
 
+///
+/// "perleval()" function
+///
+static void f_perleval(typval_T *argvars, typval_T *rettv, FunPtr fptr)
+{
+  script_host_eval("perl", argvars, rettv);
+}
+
 /*
  * "range()" function
  */
diff --git a/src/nvim/ex_cmds.lua b/src/nvim/ex_cmds.lua
index 252af409c0..a01f92df27 100644
--- a/src/nvim/ex_cmds.lua
+++ b/src/nvim/ex_cmds.lua
@@ -1927,13 +1927,19 @@ return {
     command='perl',
     flags=bit.bor(RANGE, EXTRA, DFLALL, NEEDARG, SBOXOK, CMDWIN, RESTRICT),
     addr_type=ADDR_LINES,
-    func='ex_script_ni',
+    func='ex_perl',
   },
   {
     command='perldo',
     flags=bit.bor(RANGE, EXTRA, DFLALL, NEEDARG, CMDWIN, RESTRICT),
     addr_type=ADDR_LINES,
-    func='ex_ni',
+    func='ex_perldo',
+  },
+  {
+    command='perlfile',
+    flags=bit.bor(RANGE, FILE1, NEEDARG, CMDWIN, RESTRICT),
+    addr_type=ADDR_LINES,
+    func='ex_perlfile',
   },
   {
     command='pedit',
diff --git a/src/nvim/ex_cmds2.c b/src/nvim/ex_cmds2.c
index 636fc96bde..3e169f7a4e 100644
--- a/src/nvim/ex_cmds2.c
+++ b/src/nvim/ex_cmds2.c
@@ -935,6 +935,21 @@ void ex_pydo3(exarg_T *eap)
   script_host_do_range("python3", eap);
 }
 
+void ex_perl(exarg_T *eap)
+{
+  script_host_execute("perl", eap);
+}
+
+void ex_perlfile(exarg_T *eap)
+{
+  script_host_execute_file("perl", eap);
+}
+
+void ex_perldo(exarg_T *eap)
+{
+  script_host_do_range("perl", eap);
+}
+
 // Command line expansion for :profile.
 static enum {
   PEXP_SUBCMD,          ///< expand :profile sub-commands
diff --git a/src/nvim/testdir/test_perl.vim b/src/nvim/testdir/test_perl.vim
new file mode 100644
index 0000000000..2343f389fa
--- /dev/null
+++ b/src/nvim/testdir/test_perl.vim
@@ -0,0 +1,225 @@
+" Tests for Perl interface
+
+if !has('perl') || has('win32')
+  finish
+endif
+
+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
+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')
+  call assert_equal(['', '1', '2', '3', '4'], getline(1, '$'))
+  perl @l = ('5' ..'7')
+  perl $curbuf->Append(0, @l)
+  call assert_equal(['5', '6', '7', '', '1', '2', '3', '4'], getline(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, '$'))
+  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()')))[0]->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 $curbuf = (VIM::Buffers('Xbar'))[0]
+  perl $curbuf->Append(0, $nbuf, scalar(@buflist))
+  call assert_equal(['2', '2', ''], getline(1, '$'))
+  bwipe!
+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'))
+  if has('float')
+    call assert_equal(2.5, perleval('2.5'))
+  else
+    call assert_equal(2, perleval('2.5'))
+  end
+
+  call assert_equal('abc', perleval('"abc"'))
+
+  "" 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]')
+  echo a
+  call assert_equal(a[0], a[1])
+  call assert_equal(a[2], a[3])
+  perl undef %h; undef @a;
+
+  call assert_equal('*VIM', perleval('"*VIM"'))
+endfunc
+
+func Test_perldo()
+  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 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!
+  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_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"')
+.
+  call assert_equal('AB', s)
+endfunc
+
+" vim: shiftwidth=2 sts=2 expandtab