Stop S_incline needing to temporarily write a '\0' into its passed-in

buffer. (Requires adding gv_fetchfile_flags(), savesharedpvn() and
CopFILE_setn() to provide pointer/length versions of APIs)

p4raw-id: //depot/perl@30015

diff --git a/cop.h b/cop.h
index 518a396..1062056 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -160,8 +160,10 @@ struct cop {
                                 
 #  ifdef NETWARE
 #    define CopFILE_set(c,pv)  ((c)->cop_file = savepv(pv))
+#    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savepv((pv),(l)))
 #  else
 #    define CopFILE_set(c,pv)  ((c)->cop_file = savesharedpv(pv))
+#    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savesharedpvn((pv),(l)))
 #  endif
 
 #  define CopFILESV(c)         (CopFILE(c) \
@@ -203,6 +205,7 @@ struct cop {
 #  define CopFILEGV(c)         ((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)  ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
 #  define CopFILE_set(c,pv)    CopFILEGV_set((c), gv_fetchfile(pv))
+#  define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
 #  define CopFILESV(c)         (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
 #  define CopFILEAV(c)         (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
 #  ifdef DEBUGGING

diff --git a/embed.fnc b/embed.fnc
index eeedaf8..fa499bf 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -278,6 +278,8 @@ Ap  |void   |gv_efullname   |NN SV* sv|NN const GV* gv
 Apmb   |void   |gv_efullname3  |NN SV* sv|NN const GV* gv|NULLOK const char* prefix
 Ap     |void   |gv_efullname4  |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain
 Ap     |GV*    |gv_fetchfile   |NN const char* name
+Ap     |GV*    |gv_fetchfile_flags|NN const char *const name|const STRLEN len\
+                               |const U32 flags
 Apd    |GV*    |gv_fetchmeth   |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
 Apd    |GV*    |gv_fetchmeth_autoload  |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
 Apdmb  |GV*    |gv_fetchmethod |NULLOK HV* stash|NN const char* name
@@ -704,6 +706,7 @@ p   |I32    |same_dirent    |NN const char* a|NN const char* b
 Apda   |char*  |savepv         |NULLOK const char* pv
 Apda   |char*  |savepvn        |NULLOK const char* pv|I32 len
 Apda   |char*  |savesharedpv   |NULLOK const char* pv
+Apda   |char*  |savesharedpvn  |NN const char *const pv|const STRLEN len
 Apda   |char*  |savesvpv       |NN SV* sv
 Ap     |void   |savestack_grow
 Ap     |void   |savestack_grow_cnt     |I32 need
@@ -1488,7 +1491,7 @@ s |void   |checkcomma     |NN const char *s|NN const char *name \
                                |NN const char *what
 s      |bool   |feature_is_enabled|NN const char* name|STRLEN namelen
 s      |void   |force_ident    |NN const char *s|int kind
-s      |void   |incline        |NN char *s
+s      |void   |incline        |NN const char *s
 s      |int    |intuit_method  |NN char *s|NULLOK GV *gv|NULLOK CV *cv
 s      |int    |intuit_more    |NN char *s
 s      |I32    |lop            |I32 f|int x|NN char *s

diff --git a/embed.h b/embed.h
index 08fbff4..998d73e 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -266,6 +266,7 @@
 #define gv_efullname           Perl_gv_efullname
 #define gv_efullname4          Perl_gv_efullname4
 #define gv_fetchfile           Perl_gv_fetchfile
+#define gv_fetchfile_flags     Perl_gv_fetchfile_flags
 #define gv_fetchmeth           Perl_gv_fetchmeth
 #define gv_fetchmeth_autoload  Perl_gv_fetchmeth_autoload
 #define gv_fetchmethod_autoload        Perl_gv_fetchmethod_autoload
@@ -718,6 +719,7 @@
 #define savepv                 Perl_savepv
 #define savepvn                        Perl_savepvn
 #define savesharedpv           Perl_savesharedpv
+#define savesharedpvn          Perl_savesharedpvn
 #define savesvpv               Perl_savesvpv
 #define savestack_grow         Perl_savestack_grow
 #define savestack_grow_cnt     Perl_savestack_grow_cnt
@@ -2469,6 +2471,7 @@
 #define gv_efullname(a,b)      Perl_gv_efullname(aTHX_ a,b)
 #define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d)
 #define gv_fetchfile(a)                Perl_gv_fetchfile(aTHX_ a)
+#define gv_fetchfile_flags(a,b,c)      Perl_gv_fetchfile_flags(aTHX_ a,b,c)
 #define gv_fetchmeth(a,b,c,d)  Perl_gv_fetchmeth(aTHX_ a,b,c,d)
 #define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_ a,b,c,d)
 #define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_ a,b,c)
@@ -2927,6 +2930,7 @@
 #define savepv(a)              Perl_savepv(aTHX_ a)
 #define savepvn(a,b)           Perl_savepvn(aTHX_ a,b)
 #define savesharedpv(a)                Perl_savesharedpv(aTHX_ a)
+#define savesharedpvn(a,b)     Perl_savesharedpvn(aTHX_ a,b)
 #define savesvpv(a)            Perl_savesvpv(aTHX_ a)
 #define savestack_grow()       Perl_savestack_grow(aTHX)
 #define savestack_grow_cnt(a)  Perl_savestack_grow_cnt(aTHX_ a)

diff --git a/global.sym b/global.sym
index 4ab45b5..449063a 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -133,6 +133,7 @@ Perl_gv_efullname
 Perl_gv_efullname3
 Perl_gv_efullname4
 Perl_gv_fetchfile
+Perl_gv_fetchfile_flags
 Perl_gv_fetchmeth
 Perl_gv_fetchmeth_autoload
 Perl_gv_fetchmethod
@@ -406,6 +407,7 @@ Perl_rsignal_state
 Perl_savepv
 Perl_savepvn
 Perl_savesharedpv
+Perl_savesharedpvn
 Perl_savesvpv
 Perl_savestack_grow
 Perl_savestack_grow_cnt

diff --git a/gv.c b/gv.c
index 2bb9ccb..1cc113f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -104,31 +104,39 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
 GV *
 Perl_gv_fetchfile(pTHX_ const char *name)
 {
+    return gv_fetchfile_flags(name, strlen(name), 0);
+}
+
+GV *
+Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
+                       const U32 flags)
+{
     dVAR;
     char smallbuf[128];
     char *tmpbuf;
-    STRLEN tmplen;
+    const STRLEN tmplen = namelen + 2;
     GV *gv;
 
+    PERL_UNUSED_ARG(flags);
+
     if (!PL_defstash)
        return NULL;
 
-    tmplen = strlen(name);
-    if (tmplen + 2 <= sizeof smallbuf)
+    if (tmplen <= sizeof smallbuf)
        tmpbuf = smallbuf;
     else
        Newx(tmpbuf, tmplen, char);
     /* This is where the debugger's %{"::_<$filename"} hash is created */
     tmpbuf[0] = '_';
     tmpbuf[1] = '<';
-    memcpy(tmpbuf + 2, name, tmplen);
-    gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen + 2, TRUE);
+    memcpy(tmpbuf + 2, name, namelen);
+    gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
     if (!isGV(gv)) {
-       gv_init(gv, PL_defstash, tmpbuf, tmplen + 2, FALSE);
+       gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
 #ifdef PERL_DONT_CREATE_GVSV
-       GvSV(gv) = newSVpvn(name, tmplen);
+       GvSV(gv) = newSVpvn(name, namelen);
 #else
-       sv_setpvn(GvSV(gv), name, tmplen);
+       sv_setpvn(GvSV(gv), name, namelen);
 #endif
        if (PERLDB_LINE)
            hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile);

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index d2259d5..1ce3684 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -2323,6 +2323,18 @@ which is shared between threads.
 =for hackers
 Found in file util.c
 
+=item savesharedpvn
+X<savesharedpvn>
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+       char*   savesharedpvn(const char *const pv, const STRLEN len)
+
+=for hackers
+Found in file util.c
+
 =item savesvpv
 X<savesvpv>
 

diff --git a/proto.h b/proto.h
index 4f492b0..b96cb8b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -624,6 +624,9 @@ PERL_CALLCONV void  Perl_gv_efullname4(pTHX_ SV* sv, const GV* gv, const char* pr
 PERL_CALLCONV GV*      Perl_gv_fetchfile(pTHX_ const char* name)
                        __attribute__nonnull__(pTHX_1);
 
+PERL_CALLCONV GV*      Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN len, const U32 flags)
+                       __attribute__nonnull__(pTHX_1);
+
 PERL_CALLCONV GV*      Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level)
                        __attribute__nonnull__(pTHX_2);
 
@@ -1930,6 +1933,11 @@ PERL_CALLCONV char*      Perl_savesharedpv(pTHX_ const char* pv)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV char*    Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+                       __attribute__malloc__
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+
 PERL_CALLCONV char*    Perl_savesvpv(pTHX_ SV* sv)
                        __attribute__malloc__
                        __attribute__warn_unused_result__
@@ -3991,7 +3999,7 @@ STATIC bool       S_feature_is_enabled(pTHX_ const char* name, STRLEN namelen)
 STATIC void    S_force_ident(pTHX_ const char *s, int kind)
                        __attribute__nonnull__(pTHX_1);
 
-STATIC void    S_incline(pTHX_ char *s)
+STATIC void    S_incline(pTHX_ const char *s)
                        __attribute__nonnull__(pTHX_1);
 
 STATIC int     S_intuit_method(pTHX_ char *s, GV *gv, CV *cv)

diff --git a/toke.c b/toke.c
index de921aa..51c0cf7 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -735,13 +735,12 @@ Perl_lex_end(pTHX)
  */
 
 STATIC void
-S_incline(pTHX_ char *s)
+S_incline(pTHX_ const char *s)
 {
     dVAR;
-    char *t;
-    char *n;
-    char *e;
-    char ch;
+    const char *t;
+    const char *n;
+    const char *e;
 
     CopLINE_inc(PL_curcop);
     if (*s++ != '#')
@@ -781,9 +780,8 @@ S_incline(pTHX_ char *s)
     if (*e != '\n' && *e != '\0')
        return;         /* false alarm */
 
-    ch = *t;
-    *t = '\0';
     if (t - s > 0) {
+       const STRLEN len = t - s;
 #ifndef USE_ITHREADS
        const char * const cf = CopFILE(PL_curcop);
        STRLEN tmplen = cf ? strlen(cf) : 0;
@@ -793,7 +791,7 @@ S_incline(pTHX_ char *s)
            char smallbuf[128], smallbuf2[128];
            char *tmpbuf, *tmpbuf2;
            GV **gvp, *gv2;
-           STRLEN tmplen2 = strlen(s);
+           STRLEN tmplen2 = len;
            if (tmplen + 2 <= sizeof smallbuf)
                tmpbuf = smallbuf;
            else
@@ -823,9 +821,8 @@ S_incline(pTHX_ char *s)
        }
 #endif
        CopFILE_free(PL_curcop);
-       CopFILE_set(PL_curcop, s);
+       CopFILE_setn(PL_curcop, s, len);
     }
-    *t = ch;
     CopLINE_set(PL_curcop, atoi(n)-1);
 }
 

diff --git a/util.c b/util.c
index 6959522..1e85eca 100644 (file)
--- a/util.c
+++ b/util.c
@@ -953,6 +953,27 @@ Perl_savesharedpv(pTHX_ const char *pv)
 }
 
 /*
+=for apidoc savesharedpvn
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+=cut
+*/
+char *
+Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+{
+    char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
+    assert(pv);
+    if (!newaddr) {
+       return write_no_mem();
+    }
+    newaddr[len] = '\0';
+    return (char*)memcpy(newaddr, pv, len);
+}
+
+/*
 =for apidoc savesvpv
 
 A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from