aniani/vim
0
0
Fork 1
mirror of https://github.com/vim/vim.git synced 2025-10-01 04:54:07 -04:00
Code Activity

patch 7.4.1125

Browse Source 
Problem:    There is no perleval().
Solution:   Add perleval(). (Damien)
This commit is contained in:
Bram Moolenaar
2016-01-17 21:15:58 +01:00
parent 25b2b94ea7
commit e9b892ebcd
8 changed files with 413 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

314
src/if_perl.xs
View File

@@ -117,7 +117,9 @@
#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
# 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,6 +281,13 @@ typedef int perl_key;
# 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,6 +431,13 @@ static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
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,6 +570,13 @@ static struct {
{"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,7 +679,7 @@ perl_end()
perl_free(perl_interp);
perl_interp = NULL;
#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
Perl_sys_term();
Perl_sys_term();
#endif
}
#ifdef DYNAMIC_PERL
@@ -910,11 +933,7 @@ ex_perl(eap)
SvREFCNT_dec(sv);
#ifdef AVOID_PL_ERRGV
err = SvPV(perl_get_sv("@", GV_ADD), length);
#else
err = SvPV(GvSV(PL_errgv), length);
#endif
err = CHECK_EVAL_ERR(length);
FREETMPS;
LEAVE;
@@ -949,6 +968,275 @@ replace_line(line, end)
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,11 +1272,7 @@ ex_perldo(eap)
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
str = CHECK_EVAL_ERR(length);
if (length)
goto err;
@@ -1002,11 +1286,7 @@ ex_perldo(eap)
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
str = CHECK_EVAL_ERR(length);
if (length)
break;
SPAGAIN;