Put back the cygwin32 Configure fix of 3582 undone by 3597.

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

diff --git a/util.c b/util.c
index 6755c48..3655cef 100644 (file)
--- a/util.c
+++ b/util.c
@@ -51,6 +51,10 @@
 #  include <sys/wait.h>
 #endif
 
+#ifdef I_LOCALE
+#  include <locale.h>
+#endif
+
 #define FLUSH
 
 #ifdef LEAKTEST
@@ -62,6 +66,10 @@ long lastxycount[MAXXCOUNT][MAXYCOUNT];
 
 #endif
 
+#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
+#  define FD_CLOEXEC 1                 /* NeXT needs this */
+#endif
+
 /* paranoid version of system's malloc() */
 
 /* NOTE:  Do not call the next three routines directly.  Use the macros
@@ -76,8 +84,9 @@ Perl_safesysmalloc(MEM_SIZE size)
     Malloc_t ptr;
 #ifdef HAS_64K_LIMIT
        if (size > 0xffff) {
-               PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", size) FLUSH;
-               WITH_THX(my_exit(1));
+           PerlIO_printf(PerlIO_stderr(),
+                         "Allocation too large: %lx\n", size) FLUSH;
+           WITH_THX(my_exit(1));
        }
 #endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
@@ -536,6 +545,27 @@ Perl_new_collate(pTHX_ const char *newcoll)
 #endif /* USE_LOCALE_COLLATE */
 }
 
+void
+perl_set_numeric_radix(void)
+{
+#ifdef USE_LOCALE_NUMERIC
+# ifdef HAS_LOCALECONV
+    struct lconv* lc;
+
+    lc = localeconv();
+    if (lc && lc->decimal_point)
+       /* We assume that decimal separator aka the radix
+        * character is always a single character.  If it
+        * ever is a string, this needs to be rethunk. */
+       PL_numeric_radix = *lc->decimal_point;
+    else
+       PL_numeric_radix = 0;
+# endif /* HAS_LOCALECONV */
+#else
+    PL_numeric_radix = 0;
+#endif /* USE_LOCALE_NUMERIC */
+}
+
 /*
  * Set up for a new numeric locale.
  */
@@ -559,6 +589,7 @@ Perl_new_numeric(pTHX_ const char *newnum)
        PL_numeric_name = savepv(newnum);
        PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
        PL_numeric_local = TRUE;
+       perl_set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
@@ -587,12 +618,12 @@ Perl_set_numeric_local(pTHX)
        setlocale(LC_NUMERIC, PL_numeric_name);
        PL_numeric_standard = FALSE;
        PL_numeric_local = TRUE;
+       perl_set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
 }
 
-
 /*
  * Initialize locale awareness.
  */
@@ -1382,8 +1413,8 @@ Perl_mess(pTHX_ const char *pat, va_list *args)
     return sv;
 }
 
-static OP *
-do_die(pTHX_ const char* pat, va_list *args)
+STATIC OP *
+S_do_die(pTHX_ const char* pat, va_list *args)
 {
     dTHR;
     char *message;
@@ -1458,7 +1489,7 @@ Perl_die_nocontext(const char* pat, ...)
     OP *o;
     va_list args;
     va_start(args, pat);
-    o = do_die(aTHX_ pat, &args);
+    o = do_die(pat, &args);
     va_end(args);
     return o;
 }
@@ -1470,7 +1501,7 @@ Perl_die(pTHX_ const char* pat, ...)
     OP *o;
     va_list args;
     va_start(args, pat);
-    o = do_die(aTHX_ pat, &args);
+    o = do_die(pat, &args);
     va_end(args);
     return o;
 }
@@ -1787,6 +1818,41 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
 #endif  /* PERL_USE_SAFE_PUTENV */
 }
 
+#else /* WIN32 || CYGWIN32 */
+#if defined(CYGWIN32)
+/*
+ * Save environ of perl.exe, currently Cygwin links in separate environ's
+ * for each exe/dll.  Probably should be a member of impure_ptr.
+ */
+static char ***Perl_main_environ;
+
+EXTERN_C void
+Perl_my_setenv_init(char ***penviron)
+{
+    Perl_main_environ = penviron;
+}
+
+void
+my_setenv(char *nam, char *val)
+{
+    /* You can not directly manipulate the environ[] array because
+     * the routines do some additional work that syncs the Cygwin
+     * environment with the Windows environment.
+     */
+    char *oldstr = environ[setenv_getix(nam)];
+
+    if (!val) {
+       if (!oldstr)
+           return;
+       unsetenv(nam);
+       Safefree(oldstr);
+       return;
+    }
+    setenv(nam, val, 1);
+    environ = *Perl_main_environ; /* environ realloc can occur in setenv */
+    if(oldstr && environ[setenv_getix(nam)] != oldstr)
+       Safefree(oldstr);
+}
 #else /* if WIN32 */
 
 void
@@ -1848,6 +1914,7 @@ Perl_my_setenv(pTHX_ char *nam,char *val)
 }
 
 #endif /* WIN32 */
+#endif
 
 I32
 Perl_setenv_getix(pTHX_ char *nam)
@@ -2102,7 +2169,7 @@ VTOH(vtohl,long)
 #endif
 
     /* VMS' my_popen() is in VMS.c, same with OS/2. */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC)
 PerlIO *
 Perl_my_popen(pTHX_ char *cmd, char *mode)
 {
@@ -2393,7 +2460,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
 #endif /* !HAS_SIGACTION */
 
     /* VMS' my_pclose() is in VMS.c; same with OS/2 */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC)
 I32
 Perl_my_pclose(pTHX_ PerlIO *ptr)
 {
@@ -3275,6 +3342,12 @@ Perl_get_opargs(pTHX)
  return PL_opargs;
 }
 
+PPADDR_t*
+Perl_get_ppaddr(pTHX)
+{
+ return &PL_ppaddr;
+}
+
 #ifndef HAS_GETENV_LEN
 char *
 Perl_getenv_len(pTHX_ char *env_elem, unsigned long *len)
@@ -3432,3 +3505,23 @@ Perl_my_fflush_all(pTHX)
     return EOF;
 #endif
 }
+
+double
+Perl_my_atof(pTHX_ const char* s) {
+#ifdef USE_LOCALE_NUMERIC
+    if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
+       double x, y;
+
+       x = atof(s);
+       SET_NUMERIC_STANDARD();
+       y = atof(s);
+       SET_NUMERIC_LOCAL();
+       if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
+           return y;
+       return x;
+    } else
+       return atof(s);
+#else
+    return atof(s);
+#endif
+}