Upgrade to Text-Tabs+Wrap-2006.0711. Keep the local changes from

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

diff --git a/util.c b/util.c
index fde0095..be619a3 100644 (file)
--- a/util.c
+++ b/util.c
@@ -341,16 +341,15 @@ Perl_delimcpy(pTHX_ register char *to, register const char *toend, register cons
 {
     register I32 tolen;
     PERL_UNUSED_CONTEXT;
+
     for (tolen = 0; from < fromend; from++, tolen++) {
        if (*from == '\\') {
-           if (from[1] == delim)
-               from++;
-           else {
+           if (from[1] != delim) {
                if (to < toend)
                    *to++ = *from;
                tolen++;
-               from++;
            }
+           from++;
        }
        else if (*from == delim)
            break;
@@ -1536,6 +1535,7 @@ STRLEN *
 Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
                           STRLEN size) {
     const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
+    PERL_UNUSED_CONTEXT;
 
     buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
        : PerlMemShared_realloc(buffer, len_wanted);
@@ -1577,7 +1577,9 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
        I32 max;
        char **tmpenv;
 
-       for (max = i; environ[max]; max++) ;
+       max = i;
+       while (environ[max])
+           max++;
        tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
        for (j=0; j<max; j++) {         /* copy environment */
            const int len = strlen(environ[j]);
@@ -1701,10 +1703,11 @@ Perl_setenv_getix(pTHX_ const char *nam)
 I32
 Perl_unlnk(pTHX_ const char *f)        /* unlink all versions of a file */
 {
-    I32 i;
+    I32 retries = 0;
 
-    for (i = 0; PerlLIO_unlink(f) >= 0; i++) ;
-    return i ? 0 : -1;
+    while (PerlLIO_unlink(f) >= 0)
+       retries++;
+    return retries ? 0 : -1;
 }
 #endif
 
@@ -3019,7 +3022,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
            if ((strlen(tmpbuf) + strlen(scriptname)
                 + MAX_EXT_LEN) >= sizeof tmpbuf)
                continue;       /* don't search dir with too-long name */
-           strcat(tmpbuf, scriptname);
+           my_strlcat(tmpbuf, scriptname, sizeof(tmpbuf));
 #else  /* !VMS */
 
 #ifdef DOSISH
@@ -3051,11 +3054,11 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
                len = strlen(scriptname);
                if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
                    break;
-               /* FIXME? Convert to memcpy  */
-               cur = strcpy(tmpbuf, scriptname);
+               my_strlcpy(tmpbuf, scriptname, sizeof(tmpbuf));
+               cur = tmpbuf;
            }
        } while (extidx >= 0 && ext[extidx]     /* try an extension? */
-                && strcpy(tmpbuf+len, ext[extidx++]));
+                && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len));
 #endif
     }
 #endif
@@ -3115,13 +3118,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
            if (len == 2 && tmpbuf[0] == '.')
                seen_dot = 1;
 #endif
-#ifdef HAS_STRLCAT
-           (void)strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
-#else
-           /* FIXME? Convert to memcpy by storing previous strlen(scriptname)
-            */
-           (void)strcpy(tmpbuf + len, scriptname);
-#endif /* #ifdef HAS_STRLCAT */
+           (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
 #endif  /* !VMS */
 
 #ifdef SEARCH_EXTS
@@ -3138,7 +3135,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
 #ifdef SEARCH_EXTS
            } while (  retval < 0               /* not there */
                    && extidx>=0 && ext[extidx] /* try an extension? */
-                   && strcpy(tmpbuf+len, ext[extidx++])
+                   && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len)
                );
 #endif
            if (retval < 0)
@@ -4148,7 +4145,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 
            /* Append revision */
            av_push(av, newSViv(rev));
-           if ( *pos == '.' && isDIGIT(pos[1]) )
+           if ( *pos == '.' )
                s = ++pos;
            else if ( *pos == '_' && isDIGIT(pos[1]) )
                s = ++pos;
@@ -4189,6 +4186,11 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if ( av_len(av) == -1 ) /* oops, someone forgot to pass a value */
        av_push(av, newSViv(0));
 
+    /* fix RT#19517 - special case 'undef' as string */
+    if ( *s == 'u' && strEQ(s,"undef") ) {
+       s += 5;
+    }
+
     /* And finally, store the AV in the hash */
     hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
     return s;
@@ -4294,11 +4296,12 @@ Perl_upg_version(pTHX_ SV *ver)
     if ( SvNOK(ver) ) /* may get too much accuracy */ 
     {
        char tbuf[64];
-       const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+       STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
+       while (tbuf[len-1] == '0' && len > 0) len--;
        version = savepvn(tbuf, len);
     }
 #ifdef SvVOK
-    else if ( (mg = SvVOK(ver)) ) { /* already a v-string */
+    else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
        version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
        qv = 1;
     }
@@ -4307,12 +4310,13 @@ Perl_upg_version(pTHX_ SV *ver)
     {
        version = savepv(SvPV_nolen(ver));
     }
+
     s = scan_version(version, ver, qv);
     if ( *s != '\0' ) 
-        if(ckWARN(WARN_MISC))
+       if(ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC), 
-                "Version string '%s' contains invalid data; "
-               "ignoring: '%s'", version, s);
+               "Version string '%s' contains invalid data; "
+               "ignoring: '%s'", version, s);
     Safefree(version);
     return ver;
 }
@@ -4905,7 +4909,8 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
   if (*p) {
        if (isDIGIT(*p)) {
            opt = (U32) atoi(p);
-           while (isDIGIT(*p)) p++;
+           while (isDIGIT(*p))
+               p++;
            if (*p && *p != '\n' && *p != '\r')
                 Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
        }
@@ -5042,7 +5047,8 @@ Perl_get_hash_seed(pTHX)
      UV myseed = 0;
 
      if (s)
-         while (isSPACE(*s)) s++;
+       while (isSPACE(*s))
+           s++;
      if (s && isDIGIT(*s))
          myseed = (UV)Atoul(s);
      else
@@ -5380,7 +5386,8 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
     retval = vsprintf(buffer, format, ap);
 #endif
     va_end(ap);
-    if (retval >= len)
+    /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+    if (retval < 0 || (len > 0 && (Size_t)retval >= len))
        Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
     return retval;
 }
@@ -5403,7 +5410,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     int retval;
 #ifdef NEED_VA_COPY
     va_list apc;
-    Perl_va_copy(apc);
+    Perl_va_copy(ap, apc);
 # ifdef HAS_VSNPRINTF
     retval = vsnprintf(buffer, len, format, apc);
 # else
@@ -5416,7 +5423,8 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     retval = vsprintf(buffer, format, ap);
 # endif
 #endif /* #ifdef NEED_VA_COPY */
-    if (retval >= len)
+    /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+    if (retval < 0 || (len > 0 && (Size_t)retval >= len))
        Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow");
     return retval;
 }
@@ -5516,6 +5524,39 @@ Perl_my_cxt_init(pTHX_ int *index, size_t size)
 }
 #endif
 
+#ifndef HAS_STRLCAT
+Size_t
+Perl_my_strlcat(char *dst, const char *src, Size_t size)
+{
+    Size_t used, length, copy;
+
+    used = strlen(dst);
+    length = strlen(src);
+    if (size > 0 && used < size - 1) {
+        copy = (length >= size - used) ? size - used - 1 : length;
+        memcpy(dst + used, src, copy);
+        dst[used + copy] = '\0';
+    }
+    return used + length;
+}
+#endif
+
+#ifndef HAS_STRLCPY
+Size_t
+Perl_my_strlcpy(char *dst, const char *src, Size_t size)
+{
+    Size_t length, copy;
+
+    length = strlen(src);
+    if (size > 0) {
+        copy = (length >= size) ? size - 1 : length;
+        memcpy(dst, src, copy);
+        dst[copy] = '\0';
+    }
+    return length;
+}
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd