Fwd: CPAN Upload: J/JP/JPEACOCK/version-0.70.tar.gz

[perl5.git] / util.c

diff --git a/util.c b/util.c
index 3eb4f09..d23dc8a 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,7 +1,7 @@
 /*    util.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -504,7 +504,6 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            = (unsigned char*)(SvPVX_mutable(sv) + len + PERL_FBM_TABLE_OFFSET);
        s = table - 1 - PERL_FBM_TABLE_OFFSET;  /* last char */
        memset((void*)table, mlen, 256);
-       BmFLAGS(sv) = (U8)flags;
        i = 0;
        sb = s - mlen + 1;                      /* first char (maybe) */
        while (s >= sb) {
@@ -524,6 +523,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            frequency = PL_freq[s[i]];
        }
     }
+    BmFLAGS(sv) = (U8)flags;
     BmRARE(sv) = s[rarest];
     BmPREVIOUS(sv) = rarest;
     BmUSEFUL(sv) = 100;                        /* Initial value */
@@ -769,7 +769,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
        : (((pos = *old_posp), pos += PL_screamnext[pos]) == 0)) {
       cant_find:
        if ( BmRARE(littlestr) == '\n'
-            && BmPREVIOUS(littlestr) == (U8)SvCUR(littlestr) - 1) {
+            && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
            little = (const unsigned char *)(SvPVX_const(littlestr));
            littleend = little + SvCUR(littlestr);
            first = *little++;
@@ -953,6 +953,27 @@ Perl_savesharedpv(pTHX_ const char *pv)
 }
 
 /*
+=for apidoc savesharedpvn
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+=cut
+*/
+char *
+Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+{
+    char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
+    assert(pv);
+    if (!newaddr) {
+       return write_no_mem();
+    }
+    newaddr[len] = '\0';
+    return (char*)memcpy(newaddr, pv, len);
+}
+
+/*
 =for apidoc savesvpv
 
 A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from
@@ -1271,7 +1292,7 @@ S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
 
     DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: die/croak: message = %s\ndiehook = %p\n",
-                         thr, message, PL_diehook));
+                         (void*)thr, message, (void*)PL_diehook));
     if (PL_diehook) {
        S_vdie_common(aTHX_ message, *msglen, *utf8, FALSE);
     }
@@ -1289,7 +1310,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 
     DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "%p: die: curstack = %p, mainstack = %p\n",
-                         thr, PL_curstack, PL_mainstack));
+                         (void*)thr, (void*)PL_curstack, (void*)PL_mainstack));
 
     message = vdie_croak_common(pat, args, &msglen, &utf8);
 
@@ -1297,7 +1318,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     SvFLAGS(ERRSV) |= utf8;
     DEBUG_S(PerlIO_printf(Perl_debug_log,
          "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n",
-         thr, PL_restartop, was_in_eval, PL_top_env));
+         (void*)thr, (void*)PL_restartop, was_in_eval, (void*)PL_top_env));
     if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev)
        JMPENV_JUMP(3);
     return PL_restartop;
@@ -4120,6 +4141,9 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if ( alpha && !saw_period )
        Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
 
+    if ( alpha && saw_period && width == 0 )
+       Perl_croak(aTHX_ "Invalid version format (misplaced _ in number)");
+
     if ( saw_period > 1 )
        qv = 1; /* force quoted version processing */
 
@@ -5657,6 +5681,12 @@ Perl_my_strlcpy(char *dst, const char *src, Size_t size)
 }
 #endif
 
+#if defined(_MSC_VER) && (_MSC_VER >= 1300) && (_MSC_VER < 1400) && (WINVER < 0x0500)
+/* VC7 or 7.1, building with pre-VC7 runtime libraries. */
+long _ftol( double ); /* Defined by VC6 C libs. */
+long _ftol2( double dblSource ) { return _ftol( dblSource ); }
+#endif
+
 void
 Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 {