Forgotten deMANIFESTation.

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

diff --git a/util.c b/util.c
index 26b63d0..0e5c519 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3509,30 +3509,32 @@ Perl_ebcdic_control(pTHX_ int ch)
 }
 #endif
 
-/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
- * fields for which we don't have Configure support yet:
- *   char *tm_zone;   -- abbreviation of timezone name
- *   long tm_gmtoff;  -- offset from GMT in seconds
- * To workaround core dumps from the uninitialised tm_zone we get the
+/* To workaround core dumps from the uninitialised tm_zone we get the
  * system to give us a reasonable struct to copy.  This fix means that
  * strftime uses the tm_zone and tm_gmtoff values returned by
  * localtime(time()). That should give the desired result most of the
  * time. But probably not always!
  *
- * This is a temporary workaround to be removed once Configure
- * support is added and NETaa14816 is considered in full.
- * It does not address tzname aspects of NETaa14816.
+ * This does not address tzname aspects of NETaa14816.
+ *
  */
+
 #ifdef HAS_GNULIBC
 # ifndef STRUCT_TM_HASZONE
 #    define STRUCT_TM_HASZONE
 # endif
 #endif
 
+#ifdef STRUCT_TM_HASZONE /* Backward compat */
+# ifndef HAS_TM_TM_ZONE
+#    define HAS_TM_TM_ZONE
+# endif
+#endif
+
 void
 Perl_init_tm(pTHX_ struct tm *ptm)     /* see mktime, strftime and asctime */
 {
-#ifdef STRUCT_TM_HASZONE
+#ifdef HAS_TM_TM_ZONE
     Time_t now;
     (void)time(&now);
     Copy(localtime(&now), ptm, 1, struct tm);
@@ -4012,35 +4014,39 @@ Perl_new_vstring(pTHX_ char *s, SV *sv)
        for (;;) {
            rev = 0;
            {
-           /* this is atoi() that tolerates underscores */
-           char *end = pos;
-           UV mult = 1;
-           if ( *(s-1) == '_') {
-               mult = 10;
-           }
-           while (--end >= s) {
-               UV orev;
-               orev = rev;
-               rev += (*end - '0') * mult;
-               mult *= 10;
-               if (orev > rev && ckWARN_d(WARN_OVERFLOW))
-               Perl_warner(aTHX_ WARN_OVERFLOW,
-                       "Integer overflow in decimal number");
-           }
+                /* this is atoi() that tolerates underscores */
+                char *end = pos;
+                UV mult = 1;
+                if ( *(s-1) == '_') {
+                     mult = 10;
+                }
+                while (--end >= s) {
+                     UV orev;
+                     orev = rev;
+                     rev += (*end - '0') * mult;
+                     mult *= 10;
+                     if (orev > rev && ckWARN_d(WARN_OVERFLOW))
+                          Perl_warner(aTHX_ WARN_OVERFLOW,
+                                      "Integer overflow in decimal number");
+                }
            }
+#ifdef EBCDIC
+           if (rev > 0x7FFFFFFF)
+                Perl_croak(aTHX "In EBCDIC the v-string components cannot exceed 2147483647");
+#endif
            /* Append native character for the rev point */
            tmpend = uvchr_to_utf8(tmpbuf, rev);
            sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
            if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
-           SvUTF8_on(sv);
+                SvUTF8_on(sv);
            if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1]))
-           s = ++pos;
+                s = ++pos;
            else {
-           s = pos;
-           break;
+                s = pos;
+                break;
            }
            while (isDIGIT(*pos) )
-           pos++;
+                pos++;
        }
        SvPOK_on(sv);
        SvREADONLY_on(sv);
@@ -4342,5 +4348,42 @@ Perl_sv_nounlocking(pTHX_ SV *sv)
 {
 }
 
+/*
+=for apidoc memcmp_byte_utf8
+
+Similar to memcmp(), but the first string is with bytes, the second
+with utf8.  Takes into account that the lengths may be different.
 
+=cut
+*/
 
+int
+Perl_memcmp_byte_utf8(pTHX_ char *sb, STRLEN lbyte, char *su, STRLEN lutf)
+{
+    U8 *sbyte = (U8*)sb;
+    U8 *sutf  = (U8*)su;
+    U8 *ebyte = sbyte + lbyte;
+    U8 *eutf  = sutf  + lutf;
+
+    while (sbyte < ebyte) {
+       if (sutf >= eutf)
+           return 1;                   /* utf one shorter */
+       if (NATIVE_IS_INVARIANT(*sbyte)) {
+           if (*sbyte != *sutf)
+               return *sbyte - *sutf;
+           sbyte++; sutf++;    /* CONTINUE */
+       } else if ((*sutf & UTF_CONTINUATION_MASK) ==
+                   (*sbyte >> UTF_ACCUMULATION_SHIFT)) {
+           if ((sutf[1] & UTF_CONTINUATION_MASK) !=
+                (*sbyte & UTF_CONTINUATION_MASK))
+               return (*sbyte & UTF_CONTINUATION_MASK) -
+                       (*sutf & UTF_CONTINUATION_MASK);
+           sbyte++, sutf += 2; /* CONTINUE */
+       } else
+           return (*sbyte >> UTF_ACCUMULATION_SHIFT) -
+                   (*sutf & UTF_CONTINUATION_MASK);
+    }
+    if (sutf >= eutf)
+       return 0;
+    return -1;                         /* byte one shorter */
+}