X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=85c65bf902e968806bef41b6610f6e5b751ee240;hb=055be0b80e0d5ab4109104cbf7a5f5379033e671;hp=e9580c23e7155e92e38d074d05673cc984cc4953;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index e9580c2..85c65bf 100644
--- a/sv.c
+++ b/sv.c
@@ -40,6 +40,8 @@
 #  define FAST_SV_GETS
 #endif
 
+static IV asIV _((SV* sv));
+static UV asUV _((SV* sv));
 static SV *more_sv _((void));
 static XPVIV *more_xiv _((void));
 static XPVNV *more_xnv _((void));
@@ -1001,7 +1003,7 @@ register SV *sv;
 	    sprintf(t,"(\"%.127s\")",SvPVX(sv));
     }
     else if (SvNOKp(sv)) {
-	NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	sprintf(t,"(%g)",SvNVX(sv));
     }
     else if (SvIOKp(sv))
@@ -1248,14 +1250,10 @@ register SV *sv;
 	    else
 		return (IV) U_V(SvNVX(sv));
 	}
-	if (SvPOKp(sv) && SvLEN(sv)) {
-	    if (dowarn && !looks_like_number(sv))
-		not_a_number(sv);
-	    return (IV)atol(SvPVX(sv));
-	}
-        if (!SvROK(sv)) {
-            return 0;
-        }
+	if (SvPOKp(sv) && SvLEN(sv))
+	    return asIV(sv);
+	if (!SvROK(sv))
+	    return 0;
     }
     if (SvTHINKFIRST(sv)) {
 	if (SvROK(sv)) {
@@ -1273,11 +1271,8 @@ register SV *sv;
 		else
 		    return (IV) U_V(SvNVX(sv));
 	    }
-	    if (SvPOKp(sv) && SvLEN(sv)) {
-		if (dowarn && !looks_like_number(sv))
-		    not_a_number(sv);
-		return (IV)atol(SvPVX(sv));
-	    }
+	    if (SvPOKp(sv) && SvLEN(sv))
+		return asIV(sv);
 	    if (dowarn)
 		warn(warn_uninit);
 	    return 0;
@@ -1299,13 +1294,11 @@ register SV *sv;
 	if (SvNVX(sv) < 0.0)
 	    SvIVX(sv) = I_V(SvNVX(sv));
 	else
-	    SvIVX(sv) = (IV) U_V(SvNVX(sv));
+	    SvUVX(sv) = U_V(SvNVX(sv));
     }
     else if (SvPOKp(sv) && SvLEN(sv)) {
-	if (dowarn && !looks_like_number(sv))
-	    not_a_number(sv);
 	(void)SvIOK_on(sv);
-	SvIVX(sv) = (IV)atol(SvPVX(sv));
+	SvIVX(sv) = asIV(sv);
     }
     else  {
 	if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
@@ -1317,6 +1310,72 @@ register SV *sv;
     return SvIVX(sv);
 }
 
+UV
+sv_2uv(sv)
+register SV *sv;
+{
+    if (!sv)
+	return 0;
+    if (SvGMAGICAL(sv)) {
+	mg_get(sv);
+	if (SvIOKp(sv))
+	    return SvUVX(sv);
+	if (SvNOKp(sv))
+	    return U_V(SvNVX(sv));
+	if (SvPOKp(sv) && SvLEN(sv))
+	    return asUV(sv);
+	if (!SvROK(sv))
+	    return 0;
+    }
+    if (SvTHINKFIRST(sv)) {
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	  SV* tmpstr;
+	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+	    return SvUV(tmpstr);
+#endif /* OVERLOAD */
+	  return (UV)SvRV(sv);
+	}
+	if (SvREADONLY(sv)) {
+	    if (SvNOKp(sv)) {
+		return U_V(SvNVX(sv));
+	    }
+	    if (SvPOKp(sv) && SvLEN(sv))
+		return asUV(sv);
+	    if (dowarn)
+		warn(warn_uninit);
+	    return 0;
+	}
+    }
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	sv_upgrade(sv, SVt_IV);
+	return SvUVX(sv);
+    case SVt_PV:
+	sv_upgrade(sv, SVt_PVIV);
+	break;
+    case SVt_NV:
+	sv_upgrade(sv, SVt_PVNV);
+	break;
+    }
+    if (SvNOKp(sv)) {
+	(void)SvIOK_on(sv);
+	SvUVX(sv) = U_V(SvNVX(sv));
+    }
+    else if (SvPOKp(sv) && SvLEN(sv)) {
+	(void)SvIOK_on(sv);
+	SvUVX(sv) = asUV(sv);
+    }
+    else  {
+	if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	    warn(warn_uninit);
+	return 0;
+    }
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
+	(unsigned long)sv,SvUVX(sv)));
+    return SvUVX(sv);
+}
+
 double
 sv_2nv(sv)
 register SV *sv;
@@ -1330,7 +1389,7 @@ register SV *sv;
 	if (SvPOKp(sv) && SvLEN(sv)) {
 	    if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
 		not_a_number(sv);
-	    NUMERIC_STANDARD();
+	    SET_NUMERIC_STANDARD();
 	    return atof(SvPVX(sv));
 	}
 	if (SvIOKp(sv))
@@ -1352,7 +1411,7 @@ register SV *sv;
 	    if (SvPOKp(sv) && SvLEN(sv)) {
 		if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
 		    not_a_number(sv);
-		NUMERIC_STANDARD();
+		SET_NUMERIC_STANDARD();
 		return atof(SvPVX(sv));
 	    }
 	    if (SvIOKp(sv))
@@ -1367,7 +1426,7 @@ register SV *sv;
 	    sv_upgrade(sv, SVt_PVNV);
 	else
 	    sv_upgrade(sv, SVt_NV);
-	DEBUG_c(NUMERIC_STANDARD());
+	DEBUG_c(SET_NUMERIC_STANDARD());
 	DEBUG_c(PerlIO_printf(Perl_debug_log,
 			      "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
     }
@@ -1381,7 +1440,7 @@ register SV *sv;
     else if (SvPOKp(sv) && SvLEN(sv)) {
 	if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
 	    not_a_number(sv);
-	NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	SvNVX(sv) = atof(SvPVX(sv));
     }
     else  {
@@ -1390,12 +1449,103 @@ register SV *sv;
 	return 0.0;
     }
     SvNOK_on(sv);
-    DEBUG_c(NUMERIC_STANDARD());
+    DEBUG_c(SET_NUMERIC_STANDARD());
     DEBUG_c(PerlIO_printf(Perl_debug_log,
 			  "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
     return SvNVX(sv);
 }
 
+static IV
+asIV(sv)
+SV *sv;
+{
+    I32 numtype = looks_like_number(sv);
+    double d;
+
+    if (numtype == 1)
+	return atol(SvPVX(sv));
+    if (!numtype && dowarn)
+	not_a_number(sv);
+    SET_NUMERIC_STANDARD();
+    d = atof(SvPVX(sv));
+    if (d < 0.0)
+	return I_V(d);
+    else
+	return (IV) U_V(d);
+}
+
+static UV
+asUV(sv)
+SV *sv;
+{
+    I32 numtype = looks_like_number(sv);
+
+    if (numtype == 1)
+	return atol(SvPVX(sv));
+    if (!numtype && dowarn)
+	not_a_number(sv);
+    SET_NUMERIC_STANDARD();
+    return U_V(atof(SvPVX(sv)));
+}
+
+I32
+looks_like_number(sv)
+SV *sv;
+{
+    register char *s;
+    register char *send;
+    register char *sbegin;
+    I32 numtype = 1;
+    STRLEN len;
+
+    if (SvPOK(sv)) {
+	sbegin = SvPVX(sv); 
+	len = SvCUR(sv);
+    }
+    else if (SvPOKp(sv))
+	sbegin = SvPV(sv, len);
+    else
+	return 1;
+    send = sbegin + len;
+
+    s = sbegin;
+    while (isSPACE(*s))
+	s++;
+    if (s >= send)
+	return 0;
+    if (*s == '+' || *s == '-')
+	s++;
+    while (isDIGIT(*s))
+	s++;
+    if (s == send)
+	return numtype;
+    if (*s == '.') {
+	numtype = 1;
+	s++;
+    }
+    else if (s == SvPVX(sv))
+	return 0;
+    while (isDIGIT(*s))
+	s++;
+    if (s == send)
+	return numtype;
+    if (*s == 'e' || *s == 'E') {
+	numtype = 2;
+	s++;
+	if (*s == '+' || *s == '-')
+	    s++;
+	while (isDIGIT(*s))
+	    s++;
+    }
+    while (isSPACE(*s))
+	s++;
+    if (s >= send)
+	return numtype;
+    if (len == 10 && memEQ(sbegin, "0 but true", 10))
+	return 1;
+    return 0;
+}
+
 char *
 sv_2pv(sv, lp)
 register SV *sv;
@@ -1419,7 +1569,7 @@ STRLEN *lp;
 	    goto tokensave;
 	}
 	if (SvNOKp(sv)) {
-	    NUMERIC_STANDARD();
+	    SET_NUMERIC_STANDARD();
 	    Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
 	    goto tokensave;
 	}
@@ -1455,7 +1605,7 @@ STRLEN *lp;
 		case SVt_PVCV:	s = "CODE";			break;
 		case SVt_PVGV:	s = "GLOB";			break;
 		case SVt_PVFM:	s = "FORMATLINE";		break;
-		case SVt_PVIO:	s = "FILEHANDLE";		break;
+		case SVt_PVIO:	s = "IO";			break;
 		default:	s = "UNKNOWN";			break;
 		}
 		if (SvOBJECT(sv))
@@ -1470,7 +1620,7 @@ STRLEN *lp;
 	}
 	if (SvREADONLY(sv)) {
 	    if (SvNOKp(sv)) {
-		NUMERIC_STANDARD();
+		SET_NUMERIC_STANDARD();
 		Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
 		goto tokensave;
 	    }
@@ -1498,7 +1648,7 @@ STRLEN *lp;
 	else
 #endif /*apollo*/
 	{
-	    NUMERIC_STANDARD();
+	    SET_NUMERIC_STANDARD();
 	    Gconvert(SvNVX(sv), DBL_DIG, 0, s);
 	}
 	errno = olderrno;
@@ -1648,22 +1798,20 @@ register SV *sstr;
 	(void)SvOK_off(dstr);
 	return;
     case SVt_IV:
-	if (dtype <= SVt_PV) {
+	if (dtype != SVt_IV && dtype < SVt_PVIV) {
 	    if (dtype < SVt_IV)
 		sv_upgrade(dstr, SVt_IV);
 	    else if (dtype == SVt_NV)
 		sv_upgrade(dstr, SVt_PVNV);
-	    else if (dtype <= SVt_PV)
+	    else
 		sv_upgrade(dstr, SVt_PVIV);
 	}
 	break;
     case SVt_NV:
-	if (dtype <= SVt_PVIV) {
+	if (dtype != SVt_NV && dtype < SVt_PVNV) {
 	    if (dtype < SVt_NV)
 		sv_upgrade(dstr, SVt_NV);
-	    else if (dtype == SVt_PVIV)
-		sv_upgrade(dstr, SVt_PVNV);
-	    else if (dtype <= SVt_PV)
+	    else
 		sv_upgrade(dstr, SVt_PVNV);
 	}
 	break;
@@ -1860,7 +2008,7 @@ register SV *sstr;
 	 * has to be allocated and SvPVX(sstr) has to be freed.
 	 */
 
-	if ((SvTEMP(sstr) || SvPADTMP(sstr)) && /* slated for free anyway? */
+	if (SvTEMP(sstr) &&		/* slated for free anyway? */
 	    !(sflags & SVf_OOK)) 	/* and not involved in OOK hack? */
 	{
 	    if (SvPVX(dstr)) {		/* we know that dtype >= SVt_PV */
@@ -2207,11 +2355,11 @@ I32 namlen;
     case 'l':
 	mg->mg_virtual = &vtbl_dbline;
 	break;
-#ifdef HAS_STRXFRM
+#ifdef USE_LOCALE_COLLATE
     case 'o':
         mg->mg_virtual = &vtbl_collxfrm;
         break;
-#endif
+#endif /* USE_LOCALE_COLLATE */
     case 'P':
 	mg->mg_virtual = &vtbl_pack;
 	break;
@@ -2648,7 +2796,7 @@ register SV *str2;
     if (cur1 != cur2)
 	return 0;
 
-    return !memcmp(pv1, pv2, cur1);
+    return memEQ(pv1, pv2, cur1);
 }
 
 I32
@@ -2684,7 +2832,7 @@ sv_cmp_locale(sv1, sv2)
 register SV *sv1;
 register SV *sv2;
 {
-#ifdef LC_COLLATE
+#ifdef USE_LOCALE_COLLATE
 
     char *pv1, *pv2;
     STRLEN len1, len2;
@@ -2724,12 +2872,12 @@ register SV *sv2;
   raw_compare:
     /* FALL THROUGH */
 
-#endif /* LC_COLLATE */
+#endif /* USE_LOCALE_COLLATE */
 
     return sv_cmp(sv1, sv2);
 }
 
-#ifdef LC_COLLATE
+#ifdef USE_LOCALE_COLLATE
 
 char *
 sv_collxfrm(sv, nxp)
@@ -2738,8 +2886,8 @@ sv_collxfrm(sv, nxp)
 {
     /* Any scalar variable may carry an 'o' magic that contains the
      * scalar data of the variable transformed to such a format that
-     * a normal memcmp() can be used to compare the data according
-     * to the locale settings. */
+     * a normal memory comparison can be used to compare the data
+     * according to the locale settings. */
 
     MAGIC *mg = NULL;
 
@@ -2773,7 +2921,7 @@ sv_collxfrm(sv, nxp)
     }
 }
 
-#endif /* LC_COLLATE */
+#endif /* USE_LOCALE_COLLATE */
 
 char *
 sv_gets(sv,fp,append)
@@ -2796,6 +2944,7 @@ I32 append;
     }
     if (!SvUPGRADE(sv, SVt_PV))
 	return 0;
+    SvSCREAM_off(sv);
 
     if (RsSNARF(rs)) {
 	rsptr = NULL;
@@ -2887,7 +3036,7 @@ I32 append;
 		}
 	    }
 	    else {
-	        memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */    
+	        Copy(ptr, bp, cnt, char);	     /* this     |  eat */    
 		bp += cnt;			     /* screams  |  dust */   
 		ptr += cnt;			     /* louder   |  sed :-) */
 		cnt = 0;
@@ -2943,7 +3092,7 @@ I32 append;
 
 thats_all_folks:
     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
-	  memcmp((char*)bp - rslen, rsptr, rslen))
+	  memNE((char*)bp - rslen, rsptr, rslen))
 	goto screamer;				/* go back to the fray */
 thats_really_all_folks:
     if (shortbuffered)
@@ -2990,7 +3139,7 @@ screamer2:
 	if (i != EOF &&			/* joy */
 	    (!rslen ||
 	     SvCUR(sv) < rslen ||
-	     memcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
+	     memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
 	{
 	    append = -1;
 	    goto screamer2;
@@ -3058,7 +3207,7 @@ register SV *sv;
     while (isALPHA(*d)) d++;
     while (isDIGIT(*d)) d++;
     if (*d) {
-	NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
 	return;
     }
@@ -3129,7 +3278,7 @@ register SV *sv;
 	(void)SvNOK_only(sv);
 	return;
     }
-    NUMERIC_STANDARD();
+    SET_NUMERIC_STANDARD();
     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);	/* punt */
 }
 
@@ -3264,7 +3413,6 @@ newSVsv(old)
 register SV *old;
 {
     register SV *sv;
-    U32 oflags;
 
     if (!old)
 	return Nullsv;
@@ -3276,11 +3424,10 @@ register SV *old;
     SvANY(sv) = 0;
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
-    oflags = SvFLAGS(old) & (SVs_TEMP|SVs_PADTMP);
-    if (oflags) {
-	SvFLAGS(old) &= ~(SVs_TEMP|SVs_PADTMP);
+    if (SvTEMP(old)) {
+	SvTEMP_off(old);
 	sv_setsv(sv,old);
-	SvFLAGS(old) |= oflags;
+	SvTEMP_on(old);
     }
     else
 	sv_setsv(sv,old);
@@ -3448,30 +3595,40 @@ register SV *sv;
 	}
     }
 }
-#endif /* SvTRUE */
+#endif /* !SvTRUE */
 
 #ifndef SvIV
-IV SvIV(Sv)
-register SV *Sv;
+IV
+SvIV(sv)
+register SV *sv;
 {
-    if (SvIOK(Sv))
-	return SvIVX(Sv);
-    return sv_2iv(Sv);
+    if (SvIOK(sv))
+	return SvIVX(sv);
+    return sv_2iv(sv);
 }
-#endif /* SvIV */
+#endif /* !SvIV */
 
+#ifndef SvUV
+UV
+SvUV(sv)
+register SV *sv;
+{
+    if (SvIOK(sv))
+	return SvUVX(sv);
+    return sv_2uv(sv);
+}
+#endif /* !SvUV */
 
 #ifndef SvNV
-double SvNV(Sv)
-register SV *Sv;
+double
+SvNV(sv)
+register SV *sv;
 {
-    if (SvNOK(Sv))
-	return SvNVX(Sv);
-    if (SvIOK(Sv))
-	return (double)SvIVX(Sv);
-    return sv_2nv(Sv);
+    if (SvNOK(sv))
+	return SvNVX(sv);
+    return sv_2nv(sv);
 }
-#endif /* SvNV */
+#endif /* !SvNV */
 
 #ifdef CRIPPLED_CC
 char *
@@ -3763,18 +3920,23 @@ void
 sv_untaint(sv)
 SV *sv;
 {
-    MAGIC *mg = mg_find(sv, 't');
-    if (mg)
-	mg->mg_len &= ~1;
+    if (SvMAGICAL(sv)) {
+	MAGIC *mg = mg_find(sv, 't');
+	if (mg)
+	    mg->mg_len &= ~1;
+    }
 }
 
 bool
 sv_tainted(sv)
 SV *sv;
 {
-    MAGIC *mg = mg_find(sv, 't');
-    return (mg && ((mg->mg_len & 1)
-		   || (mg->mg_len & 2) && mg->mg_obj == sv));
+    if (SvMAGICAL(sv)) {
+	MAGIC *mg = mg_find(sv, 't');
+	if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+	    return TRUE;
+    }
+    return FALSE;
 }
 
 #ifdef DEBUGGING
@@ -3920,7 +4082,7 @@ SV* sv;
     if (type >= SVt_PVIV || type == SVt_IV)
 	PerlIO_printf(Perl_debug_log, "  IV = %ld\n", (long)SvIVX(sv));
     if (type >= SVt_PVNV || type == SVt_NV) {
-	NUMERIC_STANDARD();
+	SET_NUMERIC_STANDARD();
 	PerlIO_printf(Perl_debug_log, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
     }
     if (SvROK(sv)) {