To: vim_dev@googlegroups.com Subject: Patch 7.4.1125 Fcc: outbox From: Bram Moolenaar Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ------------ 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 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(catch_peval('{"" , 0}') =~ 'Malformed key Dictionary') + call assert_true(catch_peval('{"\0" , 0}') =~ 'Malformed key Dictionary') + call assert_true(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 -- Bram@Moolenaar.net -- 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 ///