[differences between cumulative patch application and perl5.003_28]

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

diff --git a/sv.c b/sv.c
index 4139233..65d7d30 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1195,9 +1195,11 @@ SV *sv;
     char tmpbuf[64];
     char *d = tmpbuf;
     char *s;
-    int i;
+    char *limit = tmpbuf + sizeof(tmpbuf) - 8;
+                  /* each *s can expand to 4 chars + "...\0",
+                     i.e. need room for 8 chars */
 
-    for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
+    for (s = SvPVX(sv); *s && d < limit; s++) {
        int ch = *s & 0xFF;
        if (ch & 128 && !isPRINT_LC(ch)) {
            *d++ = 'M';
@@ -1502,7 +1504,7 @@ SV *sv;
     register char *s;
     register char *send;
     register char *sbegin;
-    I32 numtype = 1;
+    I32 numtype;
     STRLEN len;
 
     if (SvPOK(sv)) {
@@ -1518,31 +1520,53 @@ SV *sv;
     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++;
+
+    /* next must be digit or '.' */
+    if (isDIGIT(*s)) {
+        do {
+           s++;
+        } while (isDIGIT(*s));
+        if (*s == '.') {
+           s++;
+            while (isDIGIT(*s))  /* optional digits after "." */
+                s++;
+        }
     }
-    else if (s == SvPVX(sv))
-       return 0;
-    while (isDIGIT(*s))
-       s++;
-    if (s == send)
-       return numtype;
+    else if (*s == '.') {
+        s++;
+        /* no digits before '.' means we need digits after it */
+        if (isDIGIT(*s)) {
+           do {
+               s++;
+            } while (isDIGIT(*s));
+        }
+        else
+           return 0;
+    }
+    else
+        return 0;
+
+    /*
+     * we return 1 if the number can be converted to _integer_ with atol()
+     * and 2 if you need (int)atof().
+     */
+    numtype = 1;
+
+    /* we can have an optional exponent part */
     if (*s == 'e' || *s == 'E') {
        numtype = 2;
        s++;
        if (*s == '+' || *s == '-')
            s++;
-       while (isDIGIT(*s))
-           s++;
+        if (isDIGIT(*s)) {
+            do {
+                s++;
+            } while (isDIGIT(*s));
+        }
+        else
+            return 0;
     }
     while (isSPACE(*s))
        s++;
@@ -2927,6 +2951,11 @@ sv_collxfrm(sv, nxp)
            Safefree(mg->mg_ptr);
        s = SvPV(sv, len);
        if ((xf = mem_collxfrm(s, len, &xlen))) {
+           if (SvREADONLY(sv)) {
+               SAVEFREEPV(xf);
+               *nxp = xlen;
+               return xf;
+           }
            if (! mg) {
                sv_magic(sv, 0, 'o', 0, 0);
                mg = mg_find(sv, 'o');
@@ -2936,8 +2965,10 @@ sv_collxfrm(sv, nxp)
            mg->mg_len = xlen;
        }
        else {
-           mg->mg_ptr = NULL;
-           mg->mg_len = -1;
+           if (mg) {
+               mg->mg_ptr = NULL;
+               mg->mg_len = -1;
+           }
        }
     }
     if (mg && mg->mg_ptr) {
@@ -3090,11 +3121,8 @@ I32 append;
            PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), 
            PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0));
        /* This used to call 'filbuf' in stdio form, but as that behaves like 
-          getc when cnt <= 0 we use PerlIO_getc here to avoid another 
-          abstraction.  This may also avoid issues with different named 
-          'filbuf' equivalents, though Configure tries to handle them now
-          anyway.
-        */
+          getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
+          another abstraction.  */
        i   = PerlIO_getc(fp);          /* get more characters */
        DEBUG_P(PerlIO_printf(Perl_debug_log,
            "Screamer: post: FILE * thinks ptr=%d, cnt=%d, base=%d\n",
@@ -3593,7 +3621,7 @@ I32 lref;
            ENTER;
            tmpsv = NEWSV(704,0);
            gv_efullname3(tmpsv, gv, Nullch);
-           newSUB(start_subparse(0),
+           newSUB(start_subparse(FALSE, 0),
                   newSVOP(OP_CONST, 0, tmpsv),
                   Nullop,
                   Nullop);
@@ -3868,19 +3896,23 @@ HV* stash;
     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
        if (SvREADONLY(ref))
            croak(no_modify);
-       if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
-           --sv_objcount;
+       if (SvOBJECT(ref)) {
+           if (SvTYPE(ref) != SVt_PVIO)
+               --sv_objcount;
+           SvREFCNT_dec(SvSTASH(ref));
+       }
     }
     SvOBJECT_on(ref);
-    ++sv_objcount;
+    if (SvTYPE(ref) != SVt_PVIO)
+       ++sv_objcount;
     (void)SvUPGRADE(ref, SVt_PVMG);
     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
 
 #ifdef OVERLOAD
-    SvAMAGIC_off(sv);
-    if (Gv_AMG(stash)) {
-      SvAMAGIC_on(sv);
-    }
+    if (Gv_AMG(stash))
+       SvAMAGIC_on(sv);
+    else
+       SvAMAGIC_off(sv);
 #endif /* OVERLOAD */
 
     return sv;
@@ -4029,9 +4061,12 @@ SV* sv;
 
     switch (type) {
     case SVt_PVCV:
-      if (CvANON(sv))   strcat(d, "ANON,");
-      if (CvCLONE(sv))  strcat(d, "CLONE,");
-      if (CvCLONED(sv)) strcat(d, "CLONED,");
+    case SVt_PVFM:
+      if (CvANON(sv))          strcat(d, "ANON,");
+      if (CvUNIQUE(sv))                strcat(d, "UNIQUE,");
+      if (CvCLONE(sv))         strcat(d, "CLONE,");
+      if (CvCLONED(sv))                strcat(d, "CLONED,");
+      if (CvNODEBUG(sv))       strcat(d, "NODEBUG,");
       break;
     case SVt_PVHV:
       if (HvSHAREKEYS(sv))     strcat(d, "SHAREKEYS,");