tweak perlembed for multiplicity/usethreads sanity; correct notes

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

diff --git a/sv.c b/sv.c
index 7f7c9a6..3254cfb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1359,6 +1359,7 @@ S_not_a_number(pTHX_ SV *sv)
 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
 #define IS_NUMBER_NOT_IV        0x04 /* (IV)atof() may be != atof() */
 #define IS_NUMBER_NEG           0x08 /* not good to cache UV */
+#define IS_NUMBER_INFINITY      0x10 /* this is big */
 
 /* Actually, ISO C leaves conversion of UV to IV undefined, but
    until proven guilty, assume that things are not that bad... */
@@ -1813,6 +1814,7 @@ S_asUV(pTHX_ SV *sv)
  * IS_NUMBER_TO_INT_BY_ATOL                            123
  * IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_IV         123.1
  * IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV         123e0
+ * IS_NUMBER_INFINITY
  * with a possible addition of IS_NUMBER_NEG.
  */
 
@@ -1833,6 +1835,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
     register char *sbegin;
     register char *nbegin;
     I32 numtype = 0;
+    I32 sawinf  = 0;
     STRLEN len;
 
     if (SvPOK(sv)) {
@@ -1862,7 +1865,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
      * (int)atof().
      */
 
-    /* next must be digit or the radix separator */
+    /* next must be digit or the radix separator or beginning of infinity */
     if (isDIGIT(*s)) {
         do {
            s++;
@@ -1900,23 +1903,38 @@ Perl_looks_like_number(pTHX_ SV *sv)
         else
            return 0;
     }
+    else if (*s == 'I' || *s == 'i') {
+       s++; if (*s != 'N' && *s != 'n') return 0;
+       s++; if (*s != 'F' && *s != 'f') return 0;
+       s++; if (*s == 'I' || *s == 'i') {
+           s++; if (*s != 'N' && *s != 'n') return 0;
+           s++; if (*s != 'I' && *s != 'i') return 0;
+           s++; if (*s != 'T' && *s != 't') return 0;
+           s++; if (*s != 'Y' && *s != 'y') return 0;
+       }
+       sawinf = 1;
+    }
     else
         return 0;
 
-    /* we can have an optional exponent part */
-    if (*s == 'e' || *s == 'E') {
-       numtype &= ~IS_NUMBER_NEG;
-       numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
-       s++;
-       if (*s == '+' || *s == '-')
+    if (sawinf)
+       numtype = IS_NUMBER_INFINITY;
+    else {
+       /* we can have an optional exponent part */
+       if (*s == 'e' || *s == 'E') {
+           numtype &= ~IS_NUMBER_NEG;
+           numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
            s++;
-        if (isDIGIT(*s)) {
-            do {
-                s++;
-            } while (isDIGIT(*s));
-        }
-        else
-            return 0;
+           if (*s == '+' || *s == '-')
+               s++;
+           if (isDIGIT(*s)) {
+               do {
+                   s++;
+               } while (isDIGIT(*s));
+           }
+           else
+               return 0;
+       }
     }
     while (isSPACE(*s))
        s++;
@@ -2756,10 +2774,6 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            SvPV_set(dstr, SvPVX(sstr));
            SvLEN_set(dstr, SvLEN(sstr));
            SvCUR_set(dstr, SvCUR(sstr));
-           if (SvUTF8(sstr))
-               SvUTF8_on(dstr);
-           else
-               SvUTF8_off(dstr);
 
            SvTEMP_off(dstr);
            (void)SvOK_off(sstr);               /* NOTE: nukes most SvFLAGS on sstr */
@@ -2777,7 +2791,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            *SvEND(dstr) = '\0';
            (void)SvPOK_only(dstr);
        }
-       if (DO_UTF8(sstr))
+       if ((sflags & SVf_UTF8) && !IN_BYTE)
            SvUTF8_on(dstr);
        /*SUPPRESS 560*/
        if (sflags & SVp_NOK) {
@@ -3090,11 +3104,13 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
     if (!sstr)
        return;
     if ((s = SvPV(sstr, len))) {
-       if (SvUTF8(sstr))
+       if (DO_UTF8(sstr)) {
            sv_utf8_upgrade(dstr);
-       sv_catpvn(dstr,s,len);
-       if (SvUTF8(sstr))
+           sv_catpvn(dstr,s,len);
            SvUTF8_on(dstr);
+       }
+       else
+           sv_catpvn(dstr,s,len);
     }
 }
 
@@ -3451,6 +3467,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
     if (!bigstr)
        Perl_croak(aTHX_ "Can't modify non-existent substring");
     SvPV_force(bigstr, curlen);
+    (void)SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
        SvGROW(bigstr, offset+len+1);
        Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
@@ -3923,7 +3940,7 @@ Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
     if (cur1) {
        if (!str2)
            return 0;
-       if (SvUTF8(str1) != SvUTF8(str2)) {
+       if (SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) {
            if (SvUTF8(str1)) {
                sv_utf8_upgrade(str2);
            }
@@ -5935,11 +5952,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            break;
        }
 
-#ifdef USE_64_BIT_INT
-       if (!intsize)
-           intsize = 'q';
-#endif
-
        /* CONVERSION */
 
        switch (c = *q++) {
@@ -6069,7 +6081,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
                switch (intsize) {
                case 'h':       iv = (short)iv; break;
-               default:        iv = (int)iv; break;
+               default:        break;
                case 'l':       iv = (long)iv; break;
                case 'V':       break;
 #ifdef HAS_QUAD
@@ -6151,7 +6163,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
                switch (intsize) {
                case 'h':       uv = (unsigned short)uv; break;
-               default:        uv = (unsigned)uv; break;
+               default:        break;
                case 'l':       uv = (unsigned long)uv; break;
                case 'V':       break;
 #ifdef HAS_QUAD
@@ -7140,6 +7152,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
            gv = (GV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gv_dup_inc(gv);
            break;
+       case SAVEt_GENERIC_PVREF:               /* generic char* */
+           c = (char*)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = pv_dup(c);
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+           break;
         case SAVEt_GENERIC_SVREF:              /* generic sv */
         case SAVEt_SVREF:                      /* scalar reference */
            sv = (SV*)POPPTR(ss,ix);