Support faster make -s

[perl5.git] / locale.c

diff --git a/locale.c b/locale.c
index efd46fd..8775ce0 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -93,7 +93,6 @@ void
 Perl_set_numeric_radix(pTHX)
 {
 #ifdef USE_LOCALE_NUMERIC
-    dVAR;
 # ifdef HAS_LOCALECONV
     const struct lconv* const lc = localeconv();
 
@@ -148,9 +147,12 @@ Perl_new_numeric(pTHX_ const char *newnum)
      * This sets several interpreter-level variables:
      * PL_numeric_name  The default 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 default locale
-     * PL_numeric_standard A boolean indicating if the toggled state is such
-     *                  that the current locale is the C locale
+     *                  that the current locale is the program's underlying
+     *                  locale
+     * PL_numeric_standard An int indicating if the toggled state is such
+     *                  that the current locale is the C locale.  If non-zero,
+     *                  it is in C; if > 1, it means it may not be toggled away
+     *                  from C.
      * Note that both of the last two variables can be true at the same time,
      * if the underlying locale is C.  (Toggling is a no-op under these
      * circumstances.)
@@ -161,7 +163,6 @@ Perl_new_numeric(pTHX_ const char *newnum)
      * POSIX::setlocale() */
 
     char *save_newnum;
-    dVAR;
 
     if (! newnum) {
        Safefree(PL_numeric_name);
@@ -195,13 +196,11 @@ void
 Perl_set_numeric_standard(pTHX)
 {
 #ifdef USE_LOCALE_NUMERIC
-    dVAR;
-
     /* Toggle the LC_NUMERIC locale to C, if not already there.  Probably
      * should use the macros like SET_NUMERIC_STANDARD() in perl.h instead of
      * calling this directly. */
 
-    if (! PL_numeric_standard) {
+    if (_NOT_IN_NUMERIC_STANDARD) {
        setlocale(LC_NUMERIC, "C");
        PL_numeric_standard = TRUE;
        PL_numeric_local = FALSE;
@@ -217,13 +216,11 @@ void
 Perl_set_numeric_local(pTHX)
 {
 #ifdef USE_LOCALE_NUMERIC
-    dVAR;
-
     /* Toggle the LC_NUMERIC locale to the current underlying default, if not
      * already there.  Probably should use the macros like SET_NUMERIC_LOCAL()
      * in perl.h instead of calling this directly. */
 
-    if (! PL_numeric_local) {
+    if (_NOT_IN_NUMERIC_LOCAL) {
        setlocale(LC_NUMERIC, PL_numeric_name);
        PL_numeric_standard = FALSE;
        PL_numeric_local = TRUE;
@@ -297,8 +294,6 @@ Perl_new_collate(pTHX_ const char *newcoll)
      * should be called directly only from this file and from
      * POSIX::setlocale() */
 
-    dVAR;
-
     if (! newcoll) {
        if (PL_collation_name) {
            ++PL_collation_ix;
@@ -490,8 +485,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     int ok = 1;
 
 #if defined(USE_LOCALE)
-    dVAR;
-
 #ifdef USE_LOCALE_CTYPE
     char *curctype   = NULL;
 #endif /* USE_LOCALE_CTYPE */
@@ -942,7 +935,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 char *
 Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
 {
-    dVAR;
     char *xbuf;
     STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
 
@@ -1382,6 +1374,61 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 
 #endif
 
+
+bool
+Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
+{
+    dVAR;
+    /* Internal function which returns if we are in the scope of a pragma that
+     * enables the locale category 'category'.  'compiling' should indicate if
+     * this is during the compilation phase (TRUE) or not (FALSE). */
+
+    const COP * const cop = (compiling) ? &PL_compiling : PL_curcop;
+
+    SV *categories = cop_hints_fetch_pvs(cop, "locale", 0);
+    if (! categories || categories == &PL_sv_placeholder) {
+        return FALSE;
+    }
+
+    /* The pseudo-category 'not_characters' is -1, so just add 1 to each to get
+     * a valid unsigned */
+    assert(category >= -1);
+    return cBOOL(SvUV(categories) & (1U << (category + 1)));
+}
+
+char *
+Perl_my_strerror(pTHX_ const int errnum) {
+
+    /* Uses C locale for the error text unless within scope of 'use locale' for
+     * LC_MESSAGES */
+
+#ifdef USE_LOCALE_MESSAGES
+    if (! IN_LC(LC_MESSAGES)) {
+        char * save_locale = setlocale(LC_MESSAGES, NULL);
+        if (! ((*save_locale == 'C' && save_locale[1] == '\0')
+                || strEQ(save_locale, "POSIX")))
+        {
+            char *errstr;
+
+            /* The next setlocale likely will zap this, so create a copy */
+            save_locale = savepv(save_locale);
+
+            setlocale(LC_MESSAGES, "C");
+
+            /* This points to the static space in Strerror, with all its
+             * limitations */
+            errstr = Strerror(errnum);
+
+            setlocale(LC_MESSAGES, save_locale);
+            Safefree(save_locale);
+            return errstr;
+        }
+    }
+#endif
+
+    return Strerror(errnum);
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd