FindBin.pm on Win32 systems

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

diff --git a/util.c b/util.c
index 820f193..4b3d32d 100644 (file)
--- a/util.c
+++ b/util.c
@@ -641,65 +641,53 @@ perl_init_i18nl10n(int printwarn)
        else
            setlocale_failure = TRUE;
     }
-    if (!setlocale_failure)
-#endif /* LC_ALL */
-    {
+    if (!setlocale_failure) {
 #ifdef USE_LOCALE_CTYPE
-       if (! (curctype = setlocale(LC_CTYPE,
-                                   (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
+       if (! (curctype =
+              setlocale(LC_CTYPE,
+                        (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
                                    ? "" : Nullch)))
            setlocale_failure = TRUE;
 #endif /* USE_LOCALE_CTYPE */
 #ifdef USE_LOCALE_COLLATE
-       if (! (curcoll = setlocale(LC_COLLATE,
-                                  (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
+       if (! (curcoll =
+              setlocale(LC_COLLATE,
+                        (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
                                   ? "" : Nullch)))
            setlocale_failure = TRUE;
 #endif /* USE_LOCALE_COLLATE */
 #ifdef USE_LOCALE_NUMERIC
-       if (! (curnum = setlocale(LC_NUMERIC,
-                                 (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
+       if (! (curnum =
+              setlocale(LC_NUMERIC,
+                        (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
                                  ? "" : Nullch)))
            setlocale_failure = TRUE;
 #endif /* USE_LOCALE_NUMERIC */
     }
 
-#else /* !LOCALE_ENVIRON_REQUIRED */
+#endif /* LC_ALL */
 
-#ifdef LC_ALL
+#endif /* !LOCALE_ENVIRON_REQUIRED */
 
+#ifdef LC_ALL
     if (! setlocale(LC_ALL, ""))
        setlocale_failure = TRUE;
-    else {
-#ifdef USE_LOCALE_CTYPE
-       curctype = setlocale(LC_CTYPE, Nullch);
-#endif /* USE_LOCALE_CTYPE */
-#ifdef USE_LOCALE_COLLATE
-       curcoll = setlocale(LC_COLLATE, Nullch);
-#endif /* USE_LOCALE_COLLATE */
-#ifdef USE_LOCALE_NUMERIC
-       curnum = setlocale(LC_NUMERIC, Nullch);
-#endif /* USE_LOCALE_NUMERIC */
-    }
-
-#else /* !LC_ALL */
+#endif /* LC_ALL */
 
+    if (!setlocale_failure) {
 #ifdef USE_LOCALE_CTYPE
-    if (! (curctype = setlocale(LC_CTYPE, "")))
-       setlocale_failure = TRUE;
+       if (! (curctype = setlocale(LC_CTYPE, "")))
+           setlocale_failure = TRUE;
 #endif /* USE_LOCALE_CTYPE */
 #ifdef USE_LOCALE_COLLATE
-    if (! (curcoll = setlocale(LC_COLLATE, "")))
-       setlocale_failure = TRUE;
+       if (! (curcoll = setlocale(LC_COLLATE, "")))
+           setlocale_failure = TRUE;
 #endif /* USE_LOCALE_COLLATE */
 #ifdef USE_LOCALE_NUMERIC
-    if (! (curnum = setlocale(LC_NUMERIC, "")))
-       setlocale_failure = TRUE;
+       if (! (curnum = setlocale(LC_NUMERIC, "")))
+           setlocale_failure = TRUE;
 #endif /* USE_LOCALE_NUMERIC */
-
-#endif /* LC_ALL */
-
-#endif /* !LOCALE_ENVIRON_REQUIRED */
+    }
 
     if (setlocale_failure) {
        char *p;
@@ -2291,9 +2279,9 @@ repeatcpy(register char *to, register char *from, I32 len, register I32 count)
     register char *frombase = from;
 
     if (len == 1) {
-       todo = *from;
+       register char c = *from;
        while (count-- > 0)
-           *to++ = todo;
+           *to++ = c;
        return;
     }
     while (count-- > 0) {
@@ -2407,6 +2395,29 @@ same_dirent(char *a, char *b)
 #endif /* !HAS_RENAME */
 
 UV
+scan_bin(char *start, I32 len, I32 *retlen)
+{
+    register char *s = start;
+    register UV retval = 0;
+    bool overflowed = FALSE;
+    while (len && *s >= '0' && *s <= '1') {
+      register UV n = retval << 1;
+      if (!overflowed && (n >> 1) != retval) {
+          warn("Integer overflow in binary number");
+          overflowed = TRUE;
+      }
+      retval = n | (*s++ - '0');
+      len--;
+    }
+    if (len && (*s >= '2' || *s <= '9')) {
+      dTHR;
+      if (ckWARN(WARN_UNSAFE))
+          warner(WARN_UNSAFE, "Illegal binary digit ignored");
+    }
+    *retlen = s - start;
+    return retval;
+}
+UV
 scan_oct(char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
@@ -2470,7 +2481,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
     dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
-    char tmpbuf[512];
+    char tmpbuf[MAXPATHLEN];
     register char *s;
     I32 len;
     int retval;
@@ -2849,11 +2860,6 @@ new_struct_thread(struct perl_thread *t)
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
 
-    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
-    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
-    PL_curstash = t->Tcurstash;   /* always be set to main? */
-
-
     /* top_env needs to be non-zero. It points to an area
        in which longjmp() stuff is stored, as C callstack
        info there at least is thread specific this has to
@@ -2870,6 +2876,25 @@ new_struct_thread(struct perl_thread *t)
     PL_in_eval = FALSE;
     PL_restartop = 0;
 
+    PL_statname = NEWSV(66,0);
+    PL_maxscream = -1;
+    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+    PL_regindent = 0;
+    PL_reginterp_cnt = 0;
+    PL_lastscream = Nullsv;
+    PL_screamfirst = 0;
+    PL_screamnext = 0;
+    PL_reg_start_tmp = 0;
+    PL_reg_start_tmpl = 0;
+
+    /* parent thread's data needs to be locked while we make copy */
+    MUTEX_LOCK(&t->mutex);
+
+    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
+    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
+    PL_curstash = t->Tcurstash;   /* always be set to main? */
+
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
     PL_nrs = newSVsv(t->Tnrs);
@@ -2883,18 +2908,6 @@ new_struct_thread(struct perl_thread *t)
     PL_bodytarget = newSVsv(t->Tbodytarget);
     PL_toptarget = newSVsv(t->Ttoptarget);
 
-    PL_statname = NEWSV(66,0);
-    PL_maxscream = -1;
-    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
-    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
-    PL_regindent = 0;
-    PL_reginterp_cnt = 0;
-    PL_lastscream = Nullsv;
-    PL_screamfirst = 0;
-    PL_screamnext = 0;
-    PL_reg_start_tmp = 0;
-    PL_reg_start_tmpl = 0;
-    
     /* Initialise all per-thread SVs that the template thread used */
     svp = AvARRAY(t->threadsv);
     for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
@@ -2917,6 +2930,9 @@ new_struct_thread(struct perl_thread *t)
     thr->next->prev = thr;
     MUTEX_UNLOCK(&PL_threads_mutex);
 
+    /* done copying parent's state */
+    MUTEX_UNLOCK(&t->mutex);
+
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
 #endif /* HAVE_THREAD_INTERN */
@@ -3062,9 +3078,11 @@ get_vtbl(int vtbl_id)
     case want_vtbl_regdatum:
        result = &PL_vtbl_regdatum;
        break;
+#ifdef USE_LOCALE_COLLATE
     case want_vtbl_collxfrm:
        result = &PL_vtbl_collxfrm;
        break;
+#endif
     case want_vtbl_amagic:
        result = &PL_vtbl_amagic;
        break;