Unicode::UCD: Work on non-ASCII platforms

[perl5.git] / util.c

diff --git a/util.c b/util.c
index 66793a3..00f3821 100644 (file)
--- a/util.c
+++ b/util.c
@@ -297,12 +297,12 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 #endif
     }
     else
-       Perl_croak_memory_wrap();
+       croak_memory_wrap();
 #ifdef PERL_TRACK_MEMPOOL
     if (sTHX <= MEM_SIZE_MAX - (MEM_SIZE)total_size)
        total_size += sTHX;
     else
-       Perl_croak_memory_wrap();
+       croak_memory_wrap();
 #endif
 #ifdef HAS_64K_LIMIT
     if (total_size > 0xffff) {
@@ -521,13 +521,13 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     const U8 *s;
     STRLEN i;
     STRLEN len;
-    STRLEN rarest = 0;
     U32 frequency = 256;
     MAGIC *mg;
+    PERL_DEB( STRLEN rarest = 0 );
 
     PERL_ARGS_ASSERT_FBM_COMPILE;
 
-    if (isGV_with_GP(sv))
+    if (isGV_with_GP(sv) || SvROK(sv))
        return;
 
     if (SvVALID(sv))
@@ -539,7 +539,9 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
        if (mg && mg->mg_len >= 0)
            mg->mg_len++;
     }
-    s = (U8*)SvPV_force_mutable(sv, len);
+    if (!SvPOK(sv) || SvNIOKp(sv))
+       s = (U8*)SvPV_force_mutable(sv, len);
+    else s = (U8 *)SvPV_mutable(sv, len);
     if (len == 0)              /* TAIL might be on a zero-length string. */
        return;
     SvUPGRADE(sv, SVt_PVMG);
@@ -589,17 +591,15 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     s = (const unsigned char*)(SvPVX_const(sv));       /* deeper magic */
     for (i = 0; i < len; i++) {
        if (PL_freq[s[i]] < frequency) {
-           rarest = i;
+           PERL_DEB( rarest = i );
            frequency = PL_freq[s[i]];
        }
     }
-    BmRARE(sv) = s[rarest];
-    BmPREVIOUS(sv) = rarest;
     BmUSEFUL(sv) = 100;                        /* Initial value */
     if (flags & FBMcf_TAIL)
        SvTAIL_on(sv);
     DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %"UVuf"\n",
-                         BmRARE(sv), BmPREVIOUS(sv)));
+                         s[rarest], (UV)rarest));
 }
 
 /* If SvTAIL(littlestr), it has a fake '\n' at end. */
@@ -1340,7 +1340,7 @@ Perl_write_to_stderr(pTHX_ SV* msv)
     if (PL_stderrgv && SvREFCNT(PL_stderrgv) 
        && (io = GvIO(PL_stderrgv))
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) 
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, "PRINT",
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT),
                            G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv);
     else {
 #ifdef USE_SFIO
@@ -1614,14 +1614,6 @@ Perl_croak_no_mem()
     my_exit(1);
 }
 
-/* saves machine code for a common noreturn idiom typically used in Newx*() */
-void
-Perl_croak_memory_wrap(void)
-{
-    Perl_croak_nocontext("%s",PL_memory_wrap);
-}
-
-
 /* does not return, used only in POPSTACK */
 void
 Perl_croak_popstack(void)
@@ -2738,7 +2730,6 @@ I32
 Perl_my_pclose(pTHX_ PerlIO *ptr)
 {
     dVAR;
-    Sigsave_t hstat, istat, qstat;
     int status;
     SV **svp;
     Pid_t pid;
@@ -2766,19 +2757,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 #endif
     close_failed = (PerlIO_close(ptr) == EOF);
     SAVE_ERRNO;
-#ifndef PERL_MICRO
-    rsignal_save(SIGHUP,  (Sighandler_t) SIG_IGN, &hstat);
-    rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &istat);
-    rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qstat);
-#endif
     if (should_wait) do {
        pid2 = wait4pid(pid, &status, 0);
     } while (pid2 == -1 && errno == EINTR);
-#ifndef PERL_MICRO
-    rsignal_restore(SIGHUP, &hstat);
-    rsignal_restore(SIGINT, &istat);
-    rsignal_restore(SIGQUIT, &qstat);
-#endif
     if (close_failed) {
        RESTORE_ERRNO;
        return -1;
@@ -2939,7 +2920,7 @@ Perl_repeatcpy(char *to, const char *from, I32 len, IV count)
     assert(len >= 0);
 
     if (count < 0)
-       Perl_croak_memory_wrap();
+       croak_memory_wrap();
 
     if (len == 1)
        memset(to, *from, count);
@@ -4318,7 +4299,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
        }
     }
     if ( qv ) { /* quoted versions always get at least three terms*/
-       I32 len = av_len(av);
+       SSize_t len = av_len(av);
        /* This for loop appears to trigger a compiler bug on OS X, as it
           loops infinitely. Yes, len is negative. No, it makes no sense.
           Compiler in question is:
@@ -4383,7 +4364,7 @@ Perl_new_version(pTHX_ SV *ver)
     if ( sv_isobject(ver) && sv_derived_from(ver, "version") )
         /* can just copy directly */
     {
-       I32 key;
+       SSize_t key;
        AV * const av = newAV();
        AV *sav;
        /* This will get reblessed later if a derived class*/
@@ -4480,8 +4461,11 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
        SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
        char *buf;
 #ifdef USE_LOCALE_NUMERIC
-       char *loc = savepv(setlocale(LC_NUMERIC, NULL));
-       setlocale(LC_NUMERIC, "C");
+       char *loc = NULL;
+        if (! PL_numeric_standard) {
+            loc = savepv(setlocale(LC_NUMERIC, NULL));
+            setlocale(LC_NUMERIC, "C");
+        }
 #endif
        if (sv) {
            Perl_sv_setpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver));
@@ -4492,8 +4476,10 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
            buf = tbuf;
        }
 #ifdef USE_LOCALE_NUMERIC
-       setlocale(LC_NUMERIC, loc);
-       Safefree(loc);
+        if (loc) {
+            setlocale(LC_NUMERIC, loc);
+            Safefree(loc);
+        }
 #endif
        while (buf[len-1] == '0' && len > 0) len--;
        if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
@@ -4622,7 +4608,8 @@ The SV returned has a refcount of 1.
 SV *
 Perl_vnumify(pTHX_ SV *vs)
 {
-    I32 i, len, digit;
+    SSize_t i, len;
+    I32 digit;
     int width;
     bool alpha = FALSE;
     SV *sv;
@@ -4799,7 +4786,8 @@ converted into version objects.
 int
 Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 {
-    I32 i,l,m,r,retval;
+    I32 i,l,m,r;
+    I32 retval;
     bool lalpha = FALSE;
     bool ralpha = FALSE;
     I32 left = 0;
@@ -5462,6 +5450,10 @@ Perl_init_global_struct(pTHX)
 #  ifdef PERL_SET_VARS
     PERL_SET_VARS(plvarsp);
 #  endif
+#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
+    plvarsp->Gsv_placeholder.sv_flags = 0;
+    memset(plvarsp->Ghash_seed, 0, sizeof(plvarsp->Ghash_seed));
+#  endif
 # undef PERL_GLOBAL_STRUCT_INIT
 # endif
     return plvarsp;