diff options
| -rw-r--r-- | embed.fnc | 6 | ||||
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | mathoms.c | 31 | ||||
| -rw-r--r-- | proto.h | 9 | ||||
| -rw-r--r-- | sv.c | 27 | ||||
| -rw-r--r-- | sv.h | 2 |
7 files changed, 54 insertions, 28 deletions
@@ -849,7 +849,9 @@ Apdmb |void |sv_unref |NN SV* sv Apd |void |sv_unref_flags |NN SV* sv|U32 flags Apd |void |sv_untaint |NN SV* sv Apd |void |sv_upgrade |NN SV* sv|U32 mt -Apd |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len +Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len +Apd |void |sv_usepvn_flags|NN SV* sv|NULLOK char* ptr|STRLEN len\ + |U32 flags Apd |void |sv_vcatpvfn |NN SV* sv|NN const char* pat|STRLEN patlen \ |NULLOK va_list* args|NULLOK SV** svargs|I32 svmax \ |NULLOK bool *maybe_tainted @@ -961,7 +963,7 @@ Apd |void |sv_setnv_mg |NN SV *sv|NV num Apd |void |sv_setpv_mg |NN SV *sv|NULLOK const char *ptr Apd |void |sv_setpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len Apd |void |sv_setsv_mg |NN SV *dstr|NULLOK SV *sstr -Apd |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len +Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len ApR |MGVTBL*|get_vtbl |int vtbl_id Ap |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \ |STRLEN pvlim @@ -881,7 +881,7 @@ #define sv_unref_flags Perl_sv_unref_flags #define sv_untaint Perl_sv_untaint #define sv_upgrade Perl_sv_upgrade -#define sv_usepvn Perl_sv_usepvn +#define sv_usepvn_flags Perl_sv_usepvn_flags #define sv_vcatpvfn Perl_sv_vcatpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn #define str_to_version Perl_str_to_version @@ -989,7 +989,6 @@ #define sv_setpv_mg Perl_sv_setpv_mg #define sv_setpvn_mg Perl_sv_setpvn_mg #define sv_setsv_mg Perl_sv_setsv_mg -#define sv_usepvn_mg Perl_sv_usepvn_mg #define get_vtbl Perl_get_vtbl #define pv_display Perl_pv_display #define dump_indent Perl_dump_indent @@ -3040,7 +3039,7 @@ #define sv_unref_flags(a,b) Perl_sv_unref_flags(aTHX_ a,b) #define sv_untaint(a) Perl_sv_untaint(aTHX_ a) #define sv_upgrade(a,b) Perl_sv_upgrade(aTHX_ a,b) -#define sv_usepvn(a,b,c) Perl_sv_usepvn(aTHX_ a,b,c) +#define sv_usepvn_flags(a,b,c,d) Perl_sv_usepvn_flags(aTHX_ a,b,c,d) #define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g) #define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g) #define str_to_version(a) Perl_str_to_version(aTHX_ a) @@ -3144,7 +3143,6 @@ #define sv_setpv_mg(a,b) Perl_sv_setpv_mg(aTHX_ a,b) #define sv_setpvn_mg(a,b,c) Perl_sv_setpvn_mg(aTHX_ a,b,c) #define sv_setsv_mg(a,b) Perl_sv_setsv_mg(aTHX_ a,b) -#define sv_usepvn_mg(a,b,c) Perl_sv_usepvn_mg(aTHX_ a,b,c) #define get_vtbl(a) Perl_get_vtbl(aTHX_ a) #define pv_display(a,b,c,d,e) Perl_pv_display(aTHX_ a,b,c,d,e) #define dump_vindent(a,b,c,d) Perl_dump_vindent(aTHX_ a,b,c,d) diff --git a/global.sym b/global.sym index e0595f21d2..61f8b4697e 100644 --- a/global.sym +++ b/global.sym @@ -529,6 +529,7 @@ Perl_sv_unref_flags Perl_sv_untaint Perl_sv_upgrade Perl_sv_usepvn +Perl_sv_usepvn_flags Perl_sv_vcatpvfn Perl_sv_vsetpvfn Perl_str_to_version @@ -1205,6 +1205,37 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) SSPUSHINT(SAVEt_DESTRUCTOR); } + +/* +=for apidoc sv_usepvn_mg + +Like C<sv_usepvn>, but also handles 'set' magic. + +=cut +*/ + +void +Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len) +{ + sv_usepvn_flags(sv,ptr,len, SV_SMAGIC); +} + +/* +=for apidoc sv_usepvn + +Tells an SV to use C<ptr> to find its string value. Implemented by +calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set' +magic. See C<sv_usepvn_flags>. + +=cut +*/ + +void +Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len) +{ + sv_usepvn_flags(sv,ptr,len, 0); +} + #endif /* NO_MATHOMS */ /* @@ -2337,7 +2337,10 @@ PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv) PERL_CALLCONV void Perl_sv_upgrade(pTHX_ SV* sv, U32 mt) __attribute__nonnull__(pTHX_1); -PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len) +/* PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len) + __attribute__nonnull__(pTHX_1); */ + +PERL_CALLCONV void Perl_sv_usepvn_flags(pTHX_ SV* sv, char* ptr, STRLEN len, U32 flags) __attribute__nonnull__(pTHX_1); PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted) @@ -2634,8 +2637,8 @@ PERL_CALLCONV void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len) PERL_CALLCONV void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr) __attribute__nonnull__(pTHX_1); -PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len) - __attribute__nonnull__(pTHX_1); +/* PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len) + __attribute__nonnull__(pTHX_1); */ PERL_CALLCONV MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id) __attribute__warn_unused_result__; @@ -3885,7 +3885,7 @@ Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr) } /* -=for apidoc sv_usepvn +=for apidoc sv_usepvn_flags Tells an SV to use C<ptr> to find its string value. Normally the string is stored inside the SV but sv_usepvn allows the SV to use an @@ -3894,14 +3894,14 @@ by C<malloc>. The string length, C<len>, must be supplied. This function will realloc (i.e. move) the memory pointed to by C<ptr>, so that pointer should not be freed or used by the programmer after giving it to sv_usepvn, and neither should any pointers from "behind" -that pointer (e.g. ptr + 1) be used. Does not handle 'set' magic. -See C<sv_usepvn_mg>. +that pointer (e.g. ptr + 1) be used. If C<flags> & SV_SMAGIC is true, will +call SvSETMAGIC. =cut */ void -Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len) +Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags) { dVAR; STRLEN allocate; @@ -3909,6 +3909,8 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len) SvUPGRADE(sv, SVt_PV); if (!ptr) { (void)SvOK_off(sv); + if (flags & SV_SMAGIC) + SvSETMAGIC(sv); return; } if (SvPVX_const(sv)) @@ -3933,21 +3935,8 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len) *SvEND(sv) = '\0'; (void)SvPOK_only_UTF8(sv); /* validate pointer */ SvTAINT(sv); -} - -/* -=for apidoc sv_usepvn_mg - -Like C<sv_usepvn>, but also handles 'set' magic. - -=cut -*/ - -void -Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len) -{ - sv_usepvn(sv,ptr,len); - SvSETMAGIC(sv); + if (flags & SV_SMAGIC) + SvSETMAGIC(sv); } #ifdef PERL_OLD_COPY_ON_WRITE @@ -1640,6 +1640,8 @@ Like C<sv_catsv> but doesn't process magic. #define sv_unref(sv) sv_unref_flags(sv, 0) #define sv_force_normal(sv) sv_force_normal_flags(sv, 0) +#define sv_usepvn(sv, p, l) sv_usepvn_flags(sv, p, l, 0) +#define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC) /* We are about to replace the SV's current value. So if it's copy on write we need to normalise it. Use the SV_COW_DROP_PV flag hint to say that |