t/TEST: $failure doesnt need to use defined

[perl5.git] / locale.c

diff --git a/locale.c b/locale.c
index 85c438c..481628b 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -159,7 +159,7 @@ Perl_new_numeric(pTHX_ const char *newnum)
      * dot.
      *
      * This sets several interpreter-level variables:
-     * PL_numeric_name  The default locale's name: a copy of 'newnum'
+     * PL_numeric_name  The underlying locale's name: a copy of 'newnum'
      * PL_numeric_local A boolean indicating if the toggled state is such
      *                  that the current locale is the program's underlying
      *                  locale
@@ -527,7 +527,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     char *p;
     const bool locwarn = (printwarn > 1 ||
                     (printwarn &&
-                     (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
+                     (!(p = PerlEnv_getenv("PERL_BADLANG")) ||
+                      grok_atou(p, NULL))));
     bool done = FALSE;
 #ifdef WIN32
     /* In some systems you can find out the system default locale
@@ -1132,16 +1133,14 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
          * result */
         if (is_utf8) {
             wchar_t wc;
-            GCC_DIAG_IGNORE(-Wunused-result);
-            (void) mbtowc(&wc, NULL, 0);    /* Reset any shift state */
-            GCC_DIAG_RESTORE;
+            PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */
             errno = 0;
             if ((size_t)mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8))
                                                         != strlen(HYPHEN_UTF8)
                 || wc != (wchar_t) 0x2010)
             {
                 is_utf8 = FALSE;
-                DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=U+%x\n", wc));
+                DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=U+%x\n", (unsigned int)wc));
                 DEBUG_L(PerlIO_printf(Perl_debug_log,
                         "\treturn from mbtowc=%d; errno=%d; ?UTF8 locale=0\n",
                         mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8)), errno));
@@ -1426,6 +1425,8 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 
 #endif /* the code that is compiled when no nl_langinfo */
 
+#ifndef EBCDIC  /* On os390, even if the name ends with "UTF-8', it isn't a
+                   UTF-8 locale */
     /* As a last resort, look at the locale name to see if it matches
      * qr/UTF -?  * 8 /ix, or some other common locale names.  This "name", the
      * return of setlocale(), is actually defined to be opaque, so we can't
@@ -1441,8 +1442,8 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
         while ((name += strcspn(name, "Uu") + 1)
                                             <= save_input_locale + final_pos - 2)
         {
-            if (toFOLD(*(name)) != 't'
-                || toFOLD(*(name + 1)) != 'f')
+            if (!isALPHA_FOLD_NE(*name, 't')
+                || isALPHA_FOLD_NE(*(name + 1), 'f'))
             {
                 continue;
             }
@@ -1465,6 +1466,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
                               "Locale %s doesn't end with UTF-8 in name\n",
                                 save_input_locale));
     }
+#endif
 
 #ifdef WIN32
     /* http://msdn.microsoft.com/en-us/library/windows/desktop/dd317756.aspx */
@@ -1559,6 +1561,41 @@ Perl_my_strerror(pTHX_ const int errnum) {
 }
 
 /*
+
+=head1 Locale-related functions and macros
+
+=for apidoc sync_locale
+
+Changing the program's locale should be avoided by XS code.  Nevertheless,
+certain non-Perl libraries called from XS, such as C<Gtk> do so.  When this
+happens, Perl needs to be told that the locale has changed.  Use this function
+to do so, before returning to Perl.
+
+=cut
+*/
+
+void
+Perl_sync_locale(pTHX)
+{
+
+#ifdef USE_LOCALE_CTYPE
+    new_ctype(setlocale(LC_CTYPE, NULL));
+#endif /* USE_LOCALE_CTYPE */
+
+#ifdef USE_LOCALE_COLLATE
+    new_collate(setlocale(LC_COLLATE, NULL));
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
+    set_numeric_local();    /* Switch from "C" to underlying LC_NUMERIC */
+    new_numeric(setlocale(LC_NUMERIC, NULL));
+#endif /* USE_LOCALE_NUMERIC */
+
+}
+
+
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4