Add len flag to newCONSTSUB_flags

This function was added after 5.14.0, so it is not too late to
change it.  It is currently unused.

diff --git a/embed.fnc b/embed.fnc
index 6b22a3e..37c15ce 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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

diff --git a/embed.h b/embed.h
index d8d2776..e27dd51 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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 6b14941..46cc458 100644 (file)
--- 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);

diff --git a/gv.c b/gv.c
index 90fb13a..1f1ee06 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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));

diff --git a/op.c b/op.c
index 8727db4..5d059d3 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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) {

diff --git a/proto.h b/proto.h
index 55f4b3b..b891da3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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__;