Patch 7.4.1125
Problem: There is no perleval().
Solution: Add perleval(). (Damien)
Files: runtime/doc/eval.txt, runtime/doc/usr_41.txt, src/eval.c,
src/if_perl.xs, src/proto/if_perl.pro, src/testdir/Make_all.mak,
src/testdir/test_perl.vim
*** ../vim-7.4.1124/runtime/doc/eval.txt 2016-01-17 15:56:29.366605222
+0100
--- runtime/doc/eval.txt 2016-01-17 21:07:56.048198005 +0100
***************
*** 1941,1946 ****
--- 1950,1956 ----
nr2char( {expr}[, {utf8}]) String single char with ASCII/UTF8 value {expr}
or( {expr}, {expr}) Number bitwise OR
pathshorten( {expr}) String shorten directory names in a path
+ perleval( {expr}) any evaluate |Perl| expression
pow( {x}, {y}) Float {x} to the power of {y}
prevnonblank( {lnum}) Number line nr of non-blank line <= {lnum}
printf( {fmt}, {expr1}...) String format text
***************
*** 4732,4737 ****
--- 4779,4795 ----
< ~/.v/a/myfile.vim ~
It doesn't matter if the path exists or not.
+ perleval({expr}) *perleval()*
+ Evaluate Perl expression {expr} in scalar context and return
+ its result converted to Vim data structures. If value can't be
+ converted, it returned as string Perl representation.
+ Note: If you want a array or hash, {expr} must returns an
+ reference of it.
+ Example: >
+ :echo perleval('[1 .. 4]')
+ < [1, 2, 3, 4]
+ {only available when compiled with the |+perl| feature}
+
pow({x}, {y}) *pow()*
Return the power of {x} to the exponent {y} as a |Float|.
{x} and {y} must evaluate to a |Float| or a |Number|.
*** ../vim-7.4.1124/runtime/doc/usr_41.txt 2016-01-03 22:47:52.975427461
+0100
--- runtime/doc/usr_41.txt 2016-01-17 21:07:56.052197961 +0100
***************
*** 917,922 ****
--- 921,927 ----
luaeval() evaluate Lua expression
mzeval() evaluate |MzScheme| expression
+ perleval() evaluate Perl expression (|+perl|)
py3eval() evaluate Python expression (|+python3|)
pyeval() evaluate Python expression (|+python|)
wordcount() get byte/word/char count of buffer
*** ../vim-7.4.1124/src/eval.c 2016-01-17 15:56:29.362605265 +0100
--- src/eval.c 2016-01-17 21:07:56.052197961 +0100
***************
*** 657,662 ****
--- 657,665 ----
static void f_nr2char __ARGS((typval_T *argvars, typval_T *rettv));
static void f_or __ARGS((typval_T *argvars, typval_T *rettv));
static void f_pathshorten __ARGS((typval_T *argvars, typval_T *rettv));
+ #ifdef FEAT_PERL
+ static void f_perleval __ARGS((typval_T *argvars, typval_T *rettv));
+ #endif
#ifdef FEAT_FLOAT
static void f_pow __ARGS((typval_T *argvars, typval_T *rettv));
#endif
***************
*** 8270,8275 ****
--- 8273,8281 ----
{"nr2char", 1, 2, f_nr2char},
{"or", 2, 2, f_or},
{"pathshorten", 1, 1, f_pathshorten},
+ #ifdef FEAT_PERL
+ {"perleval", 1, 1, f_perleval},
+ #endif
#ifdef FEAT_FLOAT
{"pow", 2, 2, f_pow},
#endif
***************
*** 15480,15485 ****
--- 15486,15508 ----
}
}
+ #ifdef FEAT_PERL
+ /*
+ * "perleval()" function
+ */
+ static void
+ f_perleval(argvars, rettv)
+ typval_T *argvars;
+ typval_T *rettv;
+ {
+ char_u *str;
+ char_u buf[NUMBUFLEN];
+
+ str = get_tv_string_buf(&argvars[0], buf);
+ do_perleval(str, rettv);
+ }
+ #endif
+
#ifdef FEAT_FLOAT
/*
* "pow()" function
*** ../vim-7.4.1124/src/if_perl.xs 2016-01-09 14:57:10.504884946 +0100
--- src/if_perl.xs 2016-01-17 21:10:52.642248602 +0100
***************
*** 117,123 ****
#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
* with MSVC and Perl version 5.14. */
! # define AVOID_PL_ERRGV
#endif
/* Compatibility hacks over */
--- 117,125 ----
#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
* with MSVC and Perl version 5.14. */
! # define CHECK_EVAL_ERR(len) SvPV(perl_get_sv("@", GV_ADD), (len));
! #else
! # define CHECK_EVAL_ERR(len) SvPV(GvSV(PL_errgv), (len));
#endif
/* Compatibility hacks over */
***************
*** 279,284 ****
--- 281,293 ----
# define PL_thr_key *dll_PL_thr_key
# endif
# endif
+ # define Perl_hv_iternext_flags dll_Perl_hv_iternext_flags
+ # define Perl_hv_iterinit dll_Perl_hv_iterinit
+ # define Perl_hv_iterkey dll_Perl_hv_iterkey
+ # define Perl_hv_iterval dll_Perl_hv_iterval
+ # define Perl_av_fetch dll_Perl_av_fetch
+ # define Perl_av_len dll_Perl_av_len
+ # define Perl_sv_2nv_flags dll_Perl_sv_2nv_flags
/*
* Declare HANDLE for perl.dll and function pointers.
***************
*** 422,427 ****
--- 431,443 ----
static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
#endif
static void (*boot_DynaLoader)_((pTHX_ CV*));
+ static HE * (*Perl_hv_iternext_flags)(pTHX_ HV *, I32);
+ static I32 (*Perl_hv_iterinit)(pTHX_ HV *);
+ static char * (*Perl_hv_iterkey)(pTHX_ HE *, I32 *);
+ static SV * (*Perl_hv_iterval)(pTHX_ HV *, HE *);
+ static SV** (*Perl_av_fetch)(pTHX_ AV *, SSize_t, I32);
+ static SSize_t (*Perl_av_len)(pTHX_ AV *);
+ static NV (*Perl_sv_2nv_flags)(pTHX_ SV *const, const I32);
/*
* Table of name to function pointer of perl.
***************
*** 554,559 ****
--- 570,582 ----
{"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
#endif
{"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
+ {"Perl_hv_iternext_flags", (PERL_PROC*)&Perl_hv_iternext_flags},
+ {"Perl_hv_iterinit", (PERL_PROC*)&Perl_hv_iterinit},
+ {"Perl_hv_iterkey", (PERL_PROC*)&Perl_hv_iterkey},
+ {"Perl_hv_iterval", (PERL_PROC*)&Perl_hv_iterval},
+ {"Perl_av_fetch", (PERL_PROC*)&Perl_av_fetch},
+ {"Perl_av_len", (PERL_PROC*)&Perl_av_len},
+ {"Perl_sv_2nv_flags", (PERL_PROC*)&Perl_sv_2nv_flags},
{"", NULL},
};
***************
*** 656,662 ****
perl_free(perl_interp);
perl_interp = NULL;
#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
! Perl_sys_term();
#endif
}
#ifdef DYNAMIC_PERL
--- 679,685 ----
perl_free(perl_interp);
perl_interp = NULL;
#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
! Perl_sys_term();
#endif
}
#ifdef DYNAMIC_PERL
***************
*** 910,920 ****
SvREFCNT_dec(sv);
! #ifdef AVOID_PL_ERRGV
! err = SvPV(perl_get_sv("@", GV_ADD), length);
! #else
! err = SvPV(GvSV(PL_errgv), length);
! #endif
FREETMPS;
LEAVE;
--- 933,939 ----
SvREFCNT_dec(sv);
! err = CHECK_EVAL_ERR(length);
FREETMPS;
LEAVE;
***************
*** 949,954 ****
--- 968,1242 ----
return OK;
}
+ static struct ref_map_S {
+ void *vim_ref;
+ SV *perl_ref;
+ struct ref_map_S *next;
+ } *ref_map = NULL;
+
+ static void
+ ref_map_free(void)
+ {
+ struct ref_map_S *tofree;
+ struct ref_map_S *refs = ref_map;
+
+ while (refs) {
+ tofree = refs;
+ refs = refs->next;
+ vim_free(tofree);
+ }
+ ref_map = NULL;
+ }
+
+ static struct ref_map_S *
+ ref_map_find_SV(sv)
+ SV *const sv;
+ {
+ struct ref_map_S *refs = ref_map;
+ int count = 350;
+
+ while (refs) {
+ if (refs->perl_ref == sv)
+ break;
+ refs = refs->next;
+ count--;
+ }
+
+ if (!refs && count > 0) {
+ refs = (struct ref_map_S *)alloc(sizeof(struct ref_map_S));
+ if (!refs)
+ return NULL;
+ refs->perl_ref = sv;
+ refs->vim_ref = NULL;
+ refs->next = ref_map;
+ ref_map = refs;
+ }
+
+ return refs;
+ }
+
+ static int
+ perl_to_vim(sv, rettv)
+ SV *sv;
+ typval_T *rettv;
+ {
+ if (SvROK(sv))
+ sv = SvRV(sv);
+
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ break;
+ case SVt_NV: /* float */
+ #ifdef FEAT_FLOAT
+ rettv->v_type = VAR_FLOAT;
+ rettv->vval.v_float = SvNV(sv);
+ break;
+ #endif
+ case SVt_IV: /* integer */
+ if (!SvROK(sv)) { /* references should be string */
+ rettv->vval.v_number = SvIV(sv);
+ break;
+ }
+ case SVt_PV: /* string */
+ {
+ size_t len = 0;
+ char * str_from = SvPV(sv, len);
+ char_u *str_to = (char_u*)alloc(sizeof(char_u) * (len + 1));
+
+ if (str_to) {
+ str_to[len] = '\0';
+
+ while (len--) {
+ if (str_from[len] == '\0')
+ str_to[len] = '\n';
+ else
+ str_to[len] = str_from[len];
+ }
+ }
+
+ rettv->v_type = VAR_STRING;
+ rettv->vval.v_string = str_to;
+ break;
+ }
+ case SVt_PVAV: /* list */
+ {
+ SSize_t size;
+ listitem_T * item;
+ SV ** item2;
+ list_T * list;
+ struct ref_map_S * refs;
+
+ if ((refs = ref_map_find_SV(sv)) == NULL)
+ return FAIL;
+
+ if (refs->vim_ref)
+ list = (list_T *) refs->vim_ref;
+ else
+ {
+ if ((list = list_alloc()) == NULL)
+ return FAIL;
+ refs->vim_ref = list;
+
+ for (size = av_len((AV*)sv); size >= 0; size--)
+ {
+ if ((item = listitem_alloc()) == NULL)
+ break;
+
+ item->li_tv.v_type = VAR_NUMBER;
+ item->li_tv.v_lock = 0;
+ item->li_tv.vval.v_number = 0;
+ list_insert(list, item, list->lv_first);
+
+ item2 = av_fetch((AV *)sv, size, 0);
+
+ if (item2 == NULL || *item2 == NULL ||
+ perl_to_vim(*item2, &item->li_tv) ==
FAIL)
+ break;
+ }
+ }
+
+ list->lv_refcount++;
+ rettv->v_type = VAR_LIST;
+ rettv->vval.v_list = list;
+ break;
+ }
+ case SVt_PVHV: /* dictionary */
+ {
+ HE * entry;
+ size_t key_len;
+ char * key;
+ dictitem_T * item;
+ SV * item2;
+ dict_T * dict;
+ struct ref_map_S * refs;
+
+ if ((refs = ref_map_find_SV(sv)) == NULL)
+ return FAIL;
+
+ if (refs->vim_ref)
+ dict = (dict_T *) refs->vim_ref;
+ else
+ {
+
+ if ((dict = dict_alloc()) == NULL)
+ return FAIL;
+ refs->vim_ref = dict;
+
+ hv_iterinit((HV *)sv);
+
+ for (entry = hv_iternext((HV *)sv); entry; entry =
hv_iternext((HV *)sv))
+ {
+ key_len = 0;
+ key = hv_iterkey(entry, (I32 *)&key_len);
+
+ if (!key || !key_len || strlen(key) < key_len) {
+ EMSG2("Malformed key Dictionary '%s'", key && *key ?
key : "(empty)");
+ break;
+ }
+
+ if ((item = dictitem_alloc((char_u *)key)) == NULL)
+ break;
+
+ item->di_tv.v_type = VAR_NUMBER;
+ item->di_tv.v_lock = 0;
+ item->di_tv.vval.v_number = 0;
+
+ if (dict_add(dict, item) == FAIL) {
+ dictitem_free(item);
+ break;
+ }
+ item2 = hv_iterval((HV *)sv, entry);
+ if (item2 == NULL || perl_to_vim(item2, &item->di_tv) ==
FAIL)
+ break;
+ }
+ }
+
+ dict->dv_refcount++;
+ rettv->v_type = VAR_DICT;
+ rettv->vval.v_dict = dict;
+ break;
+ }
+ default: /* not convertible */
+ {
+ char *val = SvPV_nolen(sv);
+ rettv->v_type = VAR_STRING;
+ rettv->vval.v_string = val ? vim_strsave((char_u *)val) : NULL;
+ break;
+ }
+ }
+ return OK;
+ }
+
+ /*
+ * "perleval()"
+ */
+ void
+ do_perleval(str, rettv)
+ char_u *str;
+ typval_T *rettv;
+ {
+ char *err = NULL;
+ STRLEN err_len = 0;
+ SV *sv = NULL;
+ #ifdef HAVE_SANDBOX
+ SV *safe;
+ #endif
+
+ if (perl_interp == NULL)
+ {
+ #ifdef DYNAMIC_PERL
+ if (!perl_enabled(TRUE))
+ {
+ EMSG(_(e_noperl));
+ return;
+ }
+ #endif
+ perl_init();
+ }
+
+ {
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ #ifdef HAVE_SANDBOX
+ if (sandbox)
+ {
+ safe = get_sv("VIM::safe", FALSE);
+ # ifndef MAKE_TEST /* avoid a warning for unreachable code */
+ if (safe == NULL || !SvTRUE(safe))
+ EMSG(_("E299: Perl evaluation forbidden in sandbox without the
Safe module"));
+ else
+ # endif
+ {
+ sv = newSVpv((char *)str, 0);
+ PUSHMARK(SP);
+ XPUSHs(safe);
+ XPUSHs(sv);
+ PUTBACK;
+ call_method("reval", G_SCALAR);
+ SPAGAIN;
+ SvREFCNT_dec(sv);
+ sv = POPs;
+ }
+ }
+ else
+ #endif /* HAVE_SANDBOX */
+ sv = eval_pv((char *)str, 0);
+
+ if (sv) {
+ perl_to_vim(sv, rettv);
+ ref_map_free();
+ err = CHECK_EVAL_ERR(err_len);
+ }
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ }
+ if (err_len)
+ msg_split((char_u *)err, highlight_attr[HLF_E]);
+ }
+
/*
* ":perldo".
*/
***************
*** 984,994 ****
sv_catpvn(sv, "}", 1);
perl_eval_sv(sv, G_DISCARD | G_NOARGS);
SvREFCNT_dec(sv);
! #ifdef AVOID_PL_ERRGV
! str = SvPV(perl_get_sv("@", GV_ADD), length);
! #else
! str = SvPV(GvSV(PL_errgv), length);
! #endif
if (length)
goto err;
--- 1272,1278 ----
sv_catpvn(sv, "}", 1);
perl_eval_sv(sv, G_DISCARD | G_NOARGS);
SvREFCNT_dec(sv);
! str = CHECK_EVAL_ERR(length);
if (length)
goto err;
***************
*** 1002,1012 ****
sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
PUSHMARK(sp);
perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
! #ifdef AVOID_PL_ERRGV
! str = SvPV(perl_get_sv("@", GV_ADD), length);
! #else
! str = SvPV(GvSV(PL_errgv), length);
! #endif
if (length)
break;
SPAGAIN;
--- 1286,1292 ----
sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
PUSHMARK(sp);
perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
! str = CHECK_EVAL_ERR(length);
if (length)
break;
SPAGAIN;
*** ../vim-7.4.1124/src/proto/if_perl.pro 2013-08-10 13:37:40.000000000
+0200
--- src/proto/if_perl.pro 2016-01-17 21:07:56.056197916 +0100
***************
*** 6,8 ****
--- 6,9 ----
void perl_buf_free __ARGS((buf_T *bp));
void ex_perl __ARGS((exarg_T *eap));
void ex_perldo __ARGS((exarg_T *eap));
+ void do_perleval __ARGS((char_u *str, typval_T *rettv));
*** ../vim-7.4.1124/src/testdir/Make_all.mak 2016-01-17 18:04:15.412608602
+0100
--- src/testdir/Make_all.mak 2016-01-17 21:07:56.056197916 +0100
***************
*** 178,184 ****
test_increment.res \
test_quickfix.res \
test_viml.res \
! test_alot.res
# Explicit dependencies.
--- 178,185 ----
test_increment.res \
test_quickfix.res \
test_viml.res \
! test_alot.res \
! test_perl.res
# Explicit dependencies.
*** ../vim-7.4.1124/src/testdir/test_perl.vim 2016-01-17 21:14:18.155980953
+0100
--- src/testdir/test_perl.vim 2016-01-17 21:07:56.056197916 +0100
***************
*** 0 ****
--- 1,74 ----
+ " Tests for Perl interface
+
+ if !has('perl')
+ finish
+ end
+
+ set nocp viminfo+=nviminfo
+
+ fu <SID>catch_peval(expr)
+ try
+ call perleval(a:expr)
+ catch
+ return v:exception
+ endtry
+ call assert_true(0, 'no exception for `perleval("'.a:expr.'")`')
+ return ''
+ endf
+
+ function 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
+
+ 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\+)')
+ endf
+
+ function Test_perldo()
+ sp __TEST__
+ exe 'read ' g:testname
+ perldo s/perl/vieux_chameau/g
+ 1
+ call assert_false(search('\Cperl'))
+ bw!
+ endf
+
+ function 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)
+ endf
*** ../vim-7.4.1124/src/version.c 2016-01-17 20:53:07.962014779 +0100
--- src/version.c 2016-01-17 21:11:46.909649711 +0100
***************
*** 743,744 ****
--- 743,746 ----
{ /* Add new patch number below this line */
+ /**/
+ 1125,
/**/
--
Engineers are widely recognized as superior marriage material: intelligent,
dependable, employed, honest, and handy around the house.
(Scott Adams - The Dilbert principle)
/// Bram Moolenaar -- [email protected] -- http://www.Moolenaar.net \\\
/// sponsor Vim, vote for features -- http://www.Vim.org/sponsor/ \\\
\\\ an exciting new programming language -- http://www.Zimbu.org ///
\\\ help me help AIDS victims -- http://ICCF-Holland.org ///
--
--
You received this message from the "vim_dev" maillist.
Do not top-post! Type your reply below the text you are replying to.
For more information, visit http://www.vim.org/maillist.php
---
You received this message because you are subscribed to the Google Groups
"vim_dev" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
For more options, visit https://groups.google.com/d/optout.
