diff options
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 6 | ||||
| -rw-r--r-- | gv.c | 5 | ||||
| -rw-r--r-- | op.c | 12 | ||||
| -rw-r--r-- | proto.h | 2 |
6 files changed, 22 insertions, 9 deletions
@@ -853,7 +853,9 @@ i |bool |aassign_common_vars |NULLOK OP* o Apda |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right Apda |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv -Apd |CV* |newCONSTSUB_flags |NULLOK HV* stash|NULLOK const char* name|U32 flags|NULLOK SV* sv +Apd |CV* |newCONSTSUB_flags|NULLOK HV* stash \ + |NULLOK const char* name|STRLEN len \ + |U32 flags|NULLOK SV* sv #ifdef PERL_MAD Ap |OP* |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block #else @@ -326,7 +326,7 @@ #define newBINOP(a,b,c,d) Perl_newBINOP(aTHX_ a,b,c,d) #define newCONDOP(a,b,c,d) Perl_newCONDOP(aTHX_ a,b,c,d) #define newCONSTSUB(a,b,c) Perl_newCONSTSUB(aTHX_ a,b,c) -#define newCONSTSUB_flags(a,b,c,d) Perl_newCONSTSUB_flags(aTHX_ a,b,c,d) +#define newCONSTSUB_flags(a,b,c,d,e) Perl_newCONSTSUB_flags(aTHX_ a,b,c,d,e) #define newCVREF(a,b) Perl_newCVREF(aTHX_ a,b) #define newFOROP(a,b,c,d,e) Perl_newFOROP(aTHX_ a,b,c,d,e) #define newGIVENOP(a,b,c) Perl_newGIVENOP(aTHX_ a,b,c) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 6b14941944..46cc458d52 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1885,13 +1885,15 @@ newCONSTSUB_type(stash, name, flags, type) int type PREINIT: CV* cv; + STRLEN len; + const char *pv = SvPV(name, len); PPCODE: switch (type) { case 0: - cv = newCONSTSUB(stash, SvPV_nolen(name), NULL); + cv = newCONSTSUB(stash, pv, NULL); break; case 1: - cv = newCONSTSUB_flags(stash, SvPV_nolen(name), flags | SvUTF8(name), NULL); + cv = newCONSTSUB_flags(stash, pv, len, flags | SvUTF8(name), NULL); break; } EXTEND(SP, 2); @@ -376,7 +376,10 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag name0 = savepvn(name,len); /* newCONSTSUB takes ownership of the reference from us. */ - cv = newCONSTSUB_flags(stash, (name0 ? name0 : name), flags, has_constant); + cv = newCONSTSUB_flags( + stash, (name0 ? name0 : name), + strlen(name0 ? name0 : name), flags, has_constant + ); /* In case op.c:S_process_special_blocks stole it: */ if (!GvCV(gv)) GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv)); @@ -6619,7 +6619,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } else { GvCV_set(gv, NULL); - cv = newCONSTSUB_flags(NULL, name, name_is_utf8 ? SVf_UTF8 : 0, const_sv); + cv = newCONSTSUB_flags( + NULL, name, name ? strlen(name) : 0, name_is_utf8 ? SVf_UTF8 : 0, + const_sv + ); } stash = (CvGV(cv) && GvSTASH(CvGV(cv))) @@ -6888,7 +6891,7 @@ See L</newCONSTSUB_flags>. CV * Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv) { - return newCONSTSUB_flags(stash, name, 0, sv); + return newCONSTSUB_flags(stash, name, name ? strlen(name) : 0, 0, sv); } /* @@ -6908,7 +6911,8 @@ compile time.) */ CV * -Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv) +Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len, + U32 flags, SV *sv) { dVAR; CV* cv; @@ -6919,6 +6923,8 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv) const char *const file = temp_sv ? SvPV_nolen_const(temp_sv) : NULL; #endif + PERL_UNUSED_ARG(len); + ENTER; if (IN_PERL_RUNTIME) { @@ -2540,7 +2540,7 @@ PERL_CALLCONV OP* Perl_newCONDOP(pTHX_ I32 flags, OP* first, OP* trueop, OP* fal assert(first) PERL_CALLCONV CV* Perl_newCONSTSUB(pTHX_ HV* stash, const char* name, SV* sv); -PERL_CALLCONV CV* Perl_newCONSTSUB_flags(pTHX_ HV* stash, const char* name, U32 flags, SV* sv); +PERL_CALLCONV CV* Perl_newCONSTSUB_flags(pTHX_ HV* stash, const char* name, STRLEN len, U32 flags, SV* sv); PERL_CALLCONV OP* Perl_newCVREF(pTHX_ I32 flags, OP* o) __attribute__malloc__ __attribute__warn_unused_result__; |