Better sv_2pv_flags implementation (avoid writing to n_a)

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index e9fe2c9..de411a5 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2323,7 +2323,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
        len = SvCUR(sv);
     }
     else if (SvPOKp(sv))
-       sbegin = SvPV(sv, len);
+       sbegin = SvPV_const(sv, len);
     else
        return SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
     return grok_number(sbegin, len, NULL);
@@ -3394,22 +3394,20 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     SV *tsv, *origsv;
     char tbuf[64];     /* Must fit sprintf/Gconvert of longest IV/NV */
     char *tmpbuf = tbuf;
-    STRLEN n_a;
-
-    if (!lp) {
-       /* Saves needing to do lots of if (!lp) checks below  */
-       lp = &n_a;
-    }
 
     if (!sv) {
-       *lp = 0;
+       if (lp)
+           *lp = 0;
        return (char *)"";
     }
     if (SvGMAGICAL(sv)) {
        if (flags & SV_GMAGIC)
            mg_get(sv);
        if (SvPOKp(sv)) {
-           *lp = SvCUR(sv);
+           if (lp)
+               *lp = SvCUR(sv);
+           if (flags & SV_MUTABLE_RETURN)
+               return SvPVX_mutable(sv);
            if (flags & SV_CONST_RETURN)
                return (char *)SvPVX_const(sv);
            return SvPVX(sv);
@@ -3432,7 +3430,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
                    report_uninit(sv);
            }
-            *lp = 0;
+           if (lp)
+               *lp = 0;
             return (char *)"";
         }
     }
@@ -3442,7 +3441,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
             register const char *typestr;
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-                char *pv = SvPV(tmpstr, *lp);
+                char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
                 if (SvUTF8(tmpstr))
                     SvUTF8_on(sv);
                 else
@@ -3537,7 +3536,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                            SvUTF8_on(origsv);
                        else
                            SvUTF8_off(origsv);
-                       *lp = mg->mg_len;
+                       if (lp)
+                           *lp = mg->mg_len;
                        return mg->mg_ptr;
                    }
                                        /* Fall through */
@@ -3572,13 +3572,15 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                    Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr, PTR2UV(sv));
                goto tokensaveref;
            }
-           *lp = strlen(typestr);
+           if (lp)
+               *lp = strlen(typestr);
            return (char *)typestr;
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
                report_uninit(sv);
-           *lp = 0;
+           if (lp)
+               *lp = 0;
            return (char *)"";
        }
     }
@@ -3638,19 +3640,26 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        if (ckWARN(WARN_UNINITIALIZED)
            && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            report_uninit(sv);
+       if (lp)
        *lp = 0;
        if (SvTYPE(sv) < SVt_PV)
            /* Typically the caller expects that sv_any is not NULL now.  */
            sv_upgrade(sv, SVt_PV);
        return (char *)"";
     }
-    *lp = s - SvPVX_const(sv);
-    SvCUR_set(sv, *lp);
+    {
+       STRLEN len = s - SvPVX_const(sv);
+       if (lp) 
+           *lp = len;
+       SvCUR_set(sv, len);
+    }
     SvPOK_on(sv);
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
                          PTR2UV(sv),SvPVX_const(sv)));
     if (flags & SV_CONST_RETURN)
        return (char *)SvPVX_const(sv);
+    if (flags & SV_MUTABLE_RETURN)
+       return SvPVX_mutable(sv);
     return SvPVX(sv);
 
   tokensave:
@@ -3661,7 +3670,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        if (!tsv)
            tsv = newSVpv(tmpbuf, 0);
        sv_2mortal(tsv);
-       *lp = SvCUR(tsv);
+       if (lp)
+           *lp = SvCUR(tsv);
        return SvPVX(tsv);
     }
     else {
@@ -3685,7 +3695,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        }
 #endif
        SvUPGRADE(sv, SVt_PV);
-       *lp = len;
+       if (lp)
+           *lp = len;
        s = SvGROW(sv, len + 1);
        SvCUR_set(sv, len);
        SvPOKp_on(sv);
@@ -6226,7 +6237,8 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
  *
  */
 STATIC bool
-S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, U8 *s, U8 *start)
+S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i,
+                  I32 offsetp, const U8 *s, const U8 *start)
 {
     bool found = FALSE;
 
@@ -6259,7 +6271,7 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offset
  *
  */
 STATIC bool
-S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, U8 **sp, U8 *start, U8 *send)
+S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, const U8 **sp, const U8 *start, const U8 *send)
 {
     bool found = FALSE;
 
@@ -6391,21 +6403,21 @@ type coercion.
 void
 Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp)
 {
-    U8 *start;
+    const U8 *start;
     STRLEN len;
 
     if (!sv)
        return;
 
-    start = (U8*)SvPV(sv, len);
+    start = (U8*)SvPV_const(sv, len);
     if (len) {
        STRLEN boffset = 0;
        STRLEN *cache = 0;
-       U8 *s = start;
-        I32 uoffset = *offsetp;
-        U8 *send = s + len;
-        MAGIC *mg = 0;
-        bool found = FALSE;
+       const U8 *s = start;
+       I32 uoffset = *offsetp;
+       const U8 *send = s + len;
+       MAGIC *mg = 0;
+       bool found = FALSE;
 
          if (utf8_mg_pos(sv, &mg, &cache, 0, offsetp, *offsetp, &s, start, send))
              found = TRUE;
@@ -6467,17 +6479,17 @@ Handles magic and type coercion.
 void
 Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 {
-    U8* s;
+    const U8* s;
     STRLEN len;
 
     if (!sv)
        return;
 
-    s = (U8*)SvPV(sv, len);
+    s = (const U8*)SvPV_const(sv, len);
     if ((I32)len < *offsetp)
        Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset");
     else {
-       U8* send = s + *offsetp;
+       const U8* send = s + *offsetp;
        MAGIC* mg = NULL;
        STRLEN *cache = NULL;
 
@@ -6509,7 +6521,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
                    STRLEN backw = cache[1] - *offsetp;
 
                    if (!(forw < 2 * backw)) {
-                       U8 *p = s + cache[1];
+                       const U8 *p = s + cache[1];
                        STRLEN ubackw = 0;
                        
                        cache[1] -= backw;
@@ -9309,7 +9321,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        const char *eptr = Nullch;
        STRLEN elen = 0;
        SV *vecsv = Nullsv;
-       U8 *vecstr = Null(U8*);
+       const U8 *vecstr = Null(U8*);
        STRLEN veclen = 0;
        char c = 0;
        int i;
@@ -9429,18 +9441,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                else
                    vecsv = (evix ? evix <= svmax : svix < svmax) ?
                        svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
-               dotstr = SvPVx(vecsv, dotstrlen);
+               dotstr = SvPV_const(vecsv, dotstrlen);
                if (DO_UTF8(vecsv))
                    is_utf8 = TRUE;
            }
            if (args) {
                vecsv = va_arg(*args, SV*);
-               vecstr = (U8*)SvPVx(vecsv,veclen);
+               vecstr = (U8*)SvPV_const(vecsv,veclen);
                vec_utf8 = DO_UTF8(vecsv);
            }
            else if (efix ? efix <= svmax : svix < svmax) {
                vecsv = svargs[efix ? efix-1 : svix++];
-               vecstr = (U8*)SvPVx(vecsv,veclen);
+               vecstr = (U8*)SvPV_const(vecsv,veclen);
                vec_utf8 = DO_UTF8(vecsv);
                /* if this is a version object, we need to return the
                 * stringified representation (which the SvPVX_const has
@@ -9449,7 +9461,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if ( *q == 'd' && sv_derived_from(vecsv,"version") )
                {
                        q++; /* skip past the rest of the %vd format */
-                       eptr = (char *) vecstr;
+                       eptr = (const char *) vecstr;
                        elen = strlen(eptr);
                        vectorize=FALSE;
                        goto string;