PERL_ARGS_ASSERT_STDIZE_LOCALE;
if (s) {
- const char * const t = strchr(s, '.');
- okay = FALSE;
- if (t) {
- const char * const u = strchr(t, '\n');
- if (u && (u[1] == 0)) {
- const STRLEN len = u - s;
- Move(s + 1, locs, len, char);
- locs[len] = 0;
- okay = TRUE;
- }
- }
+ const char * const t = strchr(s, '.');
+ okay = FALSE;
+ if (t) {
+ const char * const u = strchr(t, '\n');
+ if (u && (u[1] == 0)) {
+ const STRLEN len = u - s;
+ Move(s + 1, locs, len, char);
+ locs[len] = 0;
+ okay = TRUE;
+ }
+ }
}
if (!okay)
- Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
+ Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
return locs;
}
#endif /* USE_POSIX_2008_LOCALE */
-#if 0 /* Code that was to emulate thread-safe locales on platforms that
- didn't natively support them */
-
-/* The way this would work is that we would keep a per-thread list of the
- * correct locale for that thread. Any operation that was locale-sensitive
- * would have to be changed so that it would look like this:
- *
- * SETLOCALE_LOCK;
- * setlocale to the correct locale for this operation
- * do operation
- * SETLOCALE_UNLOCK
- *
- * This leaves the global locale in the most recently used operation's, but it
- * was locked long enough to get the result. If that result is static, it
- * needs to be copied before the unlock.
- *
- * Macros could be written like SETUP_LOCALE_DEPENDENT_OP(category) that did
- * the setup, but are no-ops when not needed, and similarly,
- * END_LOCALE_DEPENDENT_OP for the tear-down
- *
- * But every call to a locale-sensitive function would have to be changed, and
- * if a module didn't cooperate by using the mutex, things would break.
- *
- * This code was abandoned before being completed or tested, and is left as-is
-*/
-
-# define do_setlocale_c(cat, locale) locking_setlocale(cat, locale, cat ## _INDEX, TRUE)
-# define do_setlocale_r(cat, locale) locking_setlocale(cat, locale, 0, FALSE)
-
-STATIC char *
-S_locking_setlocale(pTHX_
- const int category,
- const char * locale,
- int index,
- const bool is_index_valid
- )
-{
- /* This function kind of performs a setlocale() on just the current thread;
- * thus it is kind of thread-safe. It does this by keeping a thread-level
- * array of the current locales for each category. Every time a locale is
- * switched to, it does the switch globally, but updates the thread's
- * array. A query as to what the current locale is just returns the
- * appropriate element from the array, and doesn't actually call the system
- * setlocale(). The saving into the array is done in an uninterruptible
- * section of code, so is unaffected by whatever any other threads might be
- * doing.
- *
- * All locale-sensitive operations must work by first starting a critical
- * section, then switching to the thread's locale as kept by this function,
- * and then doing the operation, then ending the critical section. Thus,
- * each gets done in the appropriate locale. simulating thread-safety.
- *
- * This function takes the same parameters, 'category' and 'locale', that
- * the regular setlocale() function does, but it also takes two additional
- * ones. This is because as described earlier. If we know on input the
- * index corresponding to the category into the array where we store the
- * current locales, we don't have to calculate it. If the caller knows at
- * compile time what the index is, it can pass it, setting
- * 'is_index_valid' to TRUE; otherwise the index parameter is ignored.
- *
- */
-
- /* If the input index might be incorrect, calculate the correct one */
- if (! is_index_valid) {
- unsigned int i;
-
- if (DEBUG_Lv_TEST || debug_initialization) {
- PerlIO_printf(Perl_debug_log, "%s:%d: converting category %d to index\n", __FILE__, __LINE__, category);
- }
-
- for (i = 0; i <= LC_ALL_INDEX; i++) {
- if (category == categories[i]) {
- index = i;
- goto found_index;
- }
- }
-
- /* Here, we don't know about this category, so can't handle it.
- * XXX best we can do is to unsafely set this
- * XXX warning */
-
- return my_setlocale(category, locale);
-
- found_index: ;
-
- if (DEBUG_Lv_TEST || debug_initialization) {
- PerlIO_printf(Perl_debug_log, "%s:%d: index is 0x%x\n", __FILE__, __LINE__, index);
- }
- }
-
- /* For a query, just return what's in our records */
- if (new_locale == NULL) {
- return curlocales[index];
- }
-
-
- /* Otherwise, we need to do the switch, and save the result, all in a
- * critical section */
-
- Safefree(curlocales[[index]]);
-
- /* It might be that this is called from an already-locked section of code.
- * We would have to detect and skip the LOCK/UNLOCK if so */
- SETLOCALE_LOCK;
-
- curlocales[index] = savepv(my_setlocale(category, new_locale));
-
- if (strEQ(new_locale, "")) {
-
-#ifdef LC_ALL
-
- /* The locale values come from the environment, and may not all be the
- * same, so for LC_ALL, we have to update all the others, while the
- * mutex is still locked */
-
- if (category == LC_ALL) {
- unsigned int i;
- for (i = 0; i < LC_ALL_INDEX) {
- curlocales[i] = my_setlocale(categories[i], NULL);
- }
- }
- }
-
-#endif
-
- SETLOCALE_UNLOCK;
-
- return curlocales[index];
-}
-
-#endif
#ifdef USE_LOCALE
STATIC void
char *save_newnum;
if (! newnum) {
- Safefree(PL_numeric_name);
- PL_numeric_name = NULL;
- PL_numeric_standard = TRUE;
- PL_numeric_underlying = TRUE;
- PL_numeric_underlying_is_standard = TRUE;
- return;
+ Safefree(PL_numeric_name);
+ PL_numeric_name = NULL;
+ PL_numeric_standard = TRUE;
+ PL_numeric_underlying = TRUE;
+ PL_numeric_underlying_is_standard = TRUE;
+ return;
}
save_newnum = stdize_locale(savepv(newnum));
/* Save the new name if it isn't the same as the previous one, if any */
if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) {
- Safefree(PL_numeric_name);
- PL_numeric_name = save_newnum;
+ Safefree(PL_numeric_name);
+ PL_numeric_name = save_newnum;
}
else {
- Safefree(save_newnum);
+ Safefree(save_newnum);
}
PL_numeric_underlying_is_standard = PL_numeric_standard;
* an unlikely bug */
if (! newcoll) {
- if (PL_collation_name) {
- ++PL_collation_ix;
- Safefree(PL_collation_name);
- PL_collation_name = NULL;
- }
- PL_collation_standard = TRUE;
+ if (PL_collation_name) {
+ ++PL_collation_ix;
+ Safefree(PL_collation_name);
+ PL_collation_name = NULL;
+ }
+ PL_collation_standard = TRUE;
is_standard_collation:
- PL_collxfrm_base = 0;
- PL_collxfrm_mult = 2;
+ PL_collxfrm_base = 0;
+ PL_collxfrm_mult = 2;
PL_in_utf8_COLLATE_locale = FALSE;
PL_strxfrm_NUL_replacement = '\0';
PL_strxfrm_max_cp = 0;
- return;
+ return;
}
/* If this is not the same locale as currently, set the new one up */
if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
- ++PL_collation_ix;
- Safefree(PL_collation_name);
- PL_collation_name = stdize_locale(savepv(newcoll));
- PL_collation_standard = isNAME_C_OR_POSIX(newcoll);
+ ++PL_collation_ix;
+ Safefree(PL_collation_name);
+ PL_collation_name = stdize_locale(savepv(newcoll));
+ PL_collation_standard = isNAME_C_OR_POSIX(newcoll);
if (PL_collation_standard) {
goto is_standard_collation;
}
* get it right the first time to avoid wasted expensive string
* transformations. */
- {
+ {
/* We use the string below to find how long the tranformation of it
* is. Almost all locales are supersets of ASCII, or at least the
* ASCII letters. We use all of them, half upper half lower,
}
# endif
- }
+ }
}
#endif /* USE_LOCALE_COLLATE */
tm.tm_year = 2017 - 1900;
tm.tm_wday = 0;
tm.tm_mon = 0;
+
+ GCC_DIAG_IGNORE_STMT(-Wimplicit-fallthrough);
+
switch (item) {
default:
Perl_croak(aTHX_
break;
}
+ GCC_DIAG_RESTORE_STMT;
+
/* We can't use my_strftime() because it doesn't look at
* tm_wday */
while (0 == strftime(PL_langinfo_buf, PL_langinfo_bufsize,
DEBUG_INITIALIZATION_set(cBOOL(PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT")));
# define DEBUG_LOCALE_INIT(category, locale, result) \
- STMT_START { \
- if (debug_initialization) { \
+ STMT_START { \
+ if (debug_initialization) { \
PerlIO_printf(Perl_debug_log, \
"%s:%d: %s\n", \
__FILE__, __LINE__, \
locale, \
result)); \
} \
- } STMT_END
+ } STMT_END
/* Make sure the parallel arrays are properly set up */
# ifdef USE_LOCALE_NUMERIC
This is an alternative to using the -C command line switch
(the -C if present will override this). */
{
- const char *p = PerlEnv_getenv("PERL_UNICODE");
- PL_unicode = p ? parse_unicode_opts(&p) : 0;
- if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG)
- PL_utf8cache = -1;
+ const char *p = PerlEnv_getenv("PERL_UNICODE");
+ PL_unicode = p ? parse_unicode_opts(&p) : 0;
+ if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG)
+ PL_utf8cache = -1;
}
# endif
if (UNLIKELY(! xbuf)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"_mem_collxfrm: Couldn't malloc %zu bytes\n", xAlloc));
- goto bad;
+ goto bad;
}
/* Store the collation id */
https://perl5.git.perl.org / perl5.git / blobdiff