X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/255c2c280d69597a575e2484c66cc9564a59215b..e8ada2d0ac7fd0374d9ca5622b4ae32d9d359bea:/sv.c

diff --git a/sv.c b/sv.c
index e59e6eb..d7ed3ea 100644
--- a/sv.c
+++ b/sv.c
@@ -2509,10 +2509,6 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 {
     register char *s;
     int olderrno;
-    SV *tsv, *origsv;
-    char tbuf[64];	/* Must fit sprintf/Gconvert of longest IV/NV */
-    char *tmpbuf = tbuf;
-    STRLEN len = 0;	/* Hush gcc. len is always initialised before use.  */
 
     if (!sv) {
 	if (lp)
@@ -2531,16 +2527,44 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		return (char *)SvPVX_const(sv);
 	    return SvPVX(sv);
 	}
-	if (SvIOKp(sv)) {
-	    len = SvIsUV(sv) ? my_sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv))
-		: my_sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv));
-	    tsv = Nullsv;
-	    goto tokensave_has_len;
-	}
-	if (SvNOKp(sv)) {
-	    Gconvert(SvNVX(sv), NV_DIG, 0, tmpbuf);
-	    tsv = Nullsv;
-	    goto tokensave;
+	if (SvIOKp(sv) || SvNOKp(sv)) {
+	    char tbuf[64];  /* Must fit sprintf/Gconvert of longest IV/NV */
+	    STRLEN len;
+
+	    if (SvIOKp(sv)) {
+		len = SvIsUV(sv) ? my_sprintf(tbuf,"%"UVuf, (UV)SvUVX(sv))
+		    : my_sprintf(tbuf,"%"IVdf, (IV)SvIVX(sv));
+	    } else {
+		Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
+		len = strlen(tbuf);
+	    }
+	    if (SvROK(sv)) {	/* XXX Skip this when sv_pvn_force calls */
+		/* Sneaky stuff here */
+		SV *tsv = newSVpvn(tbuf, len);
+
+		sv_2mortal(tsv);
+		if (lp)
+		    *lp = SvCUR(tsv);
+		return SvPVX(tsv);
+	    }
+	    else {
+		dVAR;
+
+#ifdef FIXNEGATIVEZERO
+		if (len == 2 && tbuf[0] == '-' && tbuf[1] == '0') {
+		    tbuf[0] = '0';
+		    tbuf[1] = 0;
+		    len = 1;
+		}
+#endif
+		SvUPGRADE(sv, SVt_PV);
+		if (lp)
+		    *lp = len;
+		s = SvGROW_mutable(sv, len + 1);
+		SvCUR_set(sv, len);
+		SvPOKp_on(sv);
+		return memcpy(s, tbuf, len + 1);
+	    }
 	}
         if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
@@ -2555,7 +2579,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (SvTHINKFIRST(sv)) {
 	if (SvROK(sv)) {
 	    SV* tmpstr;
-            register const char *typestr;
+
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
 		/* Unwrap this:  */
@@ -2579,135 +2603,113 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                 else
                     SvUTF8_off(sv);
                 return pv;
-            }
-	    origsv = sv;
-	    sv = (SV*)SvRV(sv);
-	    if (!sv)
-		typestr = "NULLREF";
-	    else {
+            } else {
+		SV *tsv;
 		MAGIC *mg;
-		
-		switch (SvTYPE(sv)) {
-		case SVt_PVMG:
-		    if ( ((SvFLAGS(sv) &
-			   (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
-			  == (SVs_OBJECT|SVs_SMG))
-			 && (mg = mg_find(sv, PERL_MAGIC_qr))) {
-                        const regexp *re = (regexp *)mg->mg_obj;
-
-			if (!mg->mg_ptr) {
-                            const char *fptr = "msix";
-			    char reflags[6];
-			    char ch;
-			    int left = 0;
-			    int right = 4;
-                            char need_newline = 0;
- 			    U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);
-
- 			    while((ch = *fptr++)) {
- 				if(reganch & 1) {
- 				    reflags[left++] = ch;
- 				}
- 				else {
- 				    reflags[right--] = ch;
- 				}
- 				reganch >>= 1;
- 			    }
- 			    if(left != 4) {
- 				reflags[left] = '-';
- 				left = 5;
- 			    }
-
-			    mg->mg_len = re->prelen + 4 + left;
-                            /*
-                             * If /x was used, we have to worry about a regex
-                             * ending with a comment later being embedded
-                             * within another regex. If so, we don't want this
-                             * regex's "commentization" to leak out to the
-                             * right part of the enclosing regex, we must cap
-                             * it with a newline.
-                             *
-                             * So, if /x was used, we scan backwards from the
-                             * end of the regex. If we find a '#' before we
-                             * find a newline, we need to add a newline
-                             * ourself. If we find a '\n' first (or if we
-                             * don't find '#' or '\n'), we don't need to add
-                             * anything.  -jfriedl
-                             */
-                            if (PMf_EXTENDED & re->reganch)
-                            {
-                                const char *endptr = re->precomp + re->prelen;
-                                while (endptr >= re->precomp)
-                                {
-                                    const char c = *(endptr--);
-                                    if (c == '\n')
-                                        break; /* don't need another */
-                                    if (c == '#') {
-                                        /* we end while in a comment, so we
-                                           need a newline */
-                                        mg->mg_len++; /* save space for it */
-                                        need_newline = 1; /* note to add it */
-					break;
-                                    }
-                                }
-                            }
+		const SV *const referent = (SV*)SvRV(sv);
+
+		if (!referent) {
+		    tsv = sv_2mortal(newSVpvn("NULLREF", 7));
+		} else if (SvTYPE(referent) == SVt_PVMG
+			   && ((SvFLAGS(referent) &
+				(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
+			       == (SVs_OBJECT|SVs_SMG))
+			   && (mg = mg_find(referent, PERL_MAGIC_qr))) {
+		    const regexp *re = (regexp *)mg->mg_obj;
+
+		    if (!mg->mg_ptr) {
+			const char *fptr = "msix";
+			char reflags[6];
+			char ch;
+			int left = 0;
+			int right = 4;
+			char need_newline = 0;
+			U16 reganch =
+			    (U16)((re->reganch & PMf_COMPILETIME) >> 12);
+
+			while((ch = *fptr++)) {
+			    if(reganch & 1) {
+				reflags[left++] = ch;
+			    }
+			    else {
+				reflags[right--] = ch;
+			    }
+			    reganch >>= 1;
+			}
+			if(left != 4) {
+			    reflags[left] = '-';
+			    left = 5;
+			}
 
-			    Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
-			    Copy("(?", mg->mg_ptr, 2, char);
-			    Copy(reflags, mg->mg_ptr+2, left, char);
-			    Copy(":", mg->mg_ptr+left+2, 1, char);
-			    Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
-                            if (need_newline)
-                                mg->mg_ptr[mg->mg_len - 2] = '\n';
-			    mg->mg_ptr[mg->mg_len - 1] = ')';
-			    mg->mg_ptr[mg->mg_len] = 0;
+			mg->mg_len = re->prelen + 4 + left;
+			/*
+			 * If /x was used, we have to worry about a regex
+			 * ending with a comment later being embedded
+			 * within another regex. If so, we don't want this
+			 * regex's "commentization" to leak out to the
+			 * right part of the enclosing regex, we must cap
+			 * it with a newline.
+			 *
+			 * So, if /x was used, we scan backwards from the
+			 * end of the regex. If we find a '#' before we
+			 * find a newline, we need to add a newline
+			 * ourself. If we find a '\n' first (or if we
+			 * don't find '#' or '\n'), we don't need to add
+			 * anything.  -jfriedl
+			 */
+			if (PMf_EXTENDED & re->reganch) {
+			    const char *endptr = re->precomp + re->prelen;
+			    while (endptr >= re->precomp) {
+				const char c = *(endptr--);
+				if (c == '\n')
+				    break; /* don't need another */
+				if (c == '#') {
+				    /* we end while in a comment, so we
+				       need a newline */
+				    mg->mg_len++; /* save space for it */
+				    need_newline = 1; /* note to add it */
+				    break;
+				}
+			    }
 			}
-			PL_reginterp_cnt += re->program[0].next_off;
-
-			if (re->reganch & ROPT_UTF8)
-			    SvUTF8_on(origsv);
-			else
-			    SvUTF8_off(origsv);
-			if (lp)
-			    *lp = mg->mg_len;
-			return mg->mg_ptr;
+
+			Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
+			Copy("(?", mg->mg_ptr, 2, char);
+			Copy(reflags, mg->mg_ptr+2, left, char);
+			Copy(":", mg->mg_ptr+left+2, 1, char);
+			Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+			if (need_newline)
+			    mg->mg_ptr[mg->mg_len - 2] = '\n';
+			mg->mg_ptr[mg->mg_len - 1] = ')';
+			mg->mg_ptr[mg->mg_len] = 0;
 		    }
-					/* Fall through */
-		case SVt_NULL:
-		case SVt_IV:
-		case SVt_NV:
-		case SVt_RV:
-		case SVt_PV:
-		case SVt_PVIV:
-		case SVt_PVNV:
-		case SVt_PVBM:	typestr = SvVOK(sv) ? "VSTRING"
-				    : SvROK(sv) ? "REF" : "SCALAR"; break;
-		case SVt_PVLV:	typestr = SvROK(sv) ? "REF"
-				/* tied lvalues should appear to be
-				 * scalars for backwards compatitbility */
-				: (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
-				    ? "SCALAR" : "LVALUE";	break;
-		case SVt_PVAV:	typestr = "ARRAY";	break;
-		case SVt_PVHV:	typestr = "HASH";	break;
-		case SVt_PVCV:	typestr = "CODE";	break;
-		case SVt_PVGV:	typestr = "GLOB";	break;
-		case SVt_PVFM:	typestr = "FORMAT";	break;
-		case SVt_PVIO:	typestr = "IO";		break;
-		default:	typestr = "UNKNOWN";	break;
-		}
-		tsv = NEWSV(0,0);
-		if (SvOBJECT(sv)) {
-		    const char * const name = HvNAME_get(SvSTASH(sv));
-		    Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
-				   name ? name : "__ANON__" , typestr, PTR2UV(sv));
+		    PL_reginterp_cnt += re->program[0].next_off;
+
+		    if (re->reganch & ROPT_UTF8)
+			SvUTF8_on(sv);
+		    else
+			SvUTF8_off(sv);
+		    if (lp)
+			*lp = mg->mg_len;
+		    return mg->mg_ptr;
+		} else {
+		    const char *const typestr = sv_reftype(referent, 0);
+
+		    tsv = sv_newmortal();
+		    if (SvOBJECT(referent)) {
+			const char *const name = HvNAME_get(SvSTASH(referent));
+			Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
+				       name ? name : "__ANON__" , typestr,
+				       PTR2UV(referent));
+		    }
+		    else
+			Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr,
+				       PTR2UV(referent));
 		}
-		else
-		    Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr, PTR2UV(sv));
-		goto tokensaveref;
+		if (lp)
+		    *lp = SvCUR(tsv);
+		return SvPVX(tsv);
 	    }
-	    if (lp)
-		*lp = strlen(typestr);
-	    return (char *)typestr;
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    if (ckWARN(WARN_UNINITIALIZED))
@@ -2793,40 +2795,6 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (flags & SV_MUTABLE_RETURN)
 	return SvPVX_mutable(sv);
     return SvPVX(sv);
-
-  tokensave:
-    len = strlen(tmpbuf);
- tokensave_has_len:
-    assert (!tsv);
-    if (SvROK(sv)) {	/* XXX Skip this when sv_pvn_force calls */
-	/* Sneaky stuff here */
-
-      tokensaveref:
-	if (!tsv)
-	    tsv = newSVpvn(tmpbuf, len);
-	sv_2mortal(tsv);
-	if (lp)
-	    *lp = SvCUR(tsv);
-	return SvPVX(tsv);
-    }
-    else {
-        dVAR;
-
-#ifdef FIXNEGATIVEZERO
-	if (len == 2 && tmpbuf[0] == '-' && tmpbuf[1] == '0') {
-	    tmpbuf[0] = '0';
-	    tmpbuf[1] = 0;
-	    len = 1;
-	}
-#endif
-	SvUPGRADE(sv, SVt_PV);
-	if (lp)
-	    *lp = len;
-	s = SvGROW_mutable(sv, len + 1);
-	SvCUR_set(sv, len);
-	SvPOKp_on(sv);
-	return memcpy(s, tmpbuf, len + 1);
-    }
 }
 
 /*