commit d36adde059ed1c4f7af210b4f9fc3a7bd2d7d343
|
|
Author: Karl Williamson <khw@cpan.org>
|
|
Date: Wed May 23 15:32:47 2018 -0600
|
|
|
|
Fix to compile under -DNO_LOCALE
|
|
|
|
Several problems with this compile option were not caught before 5.28
|
|
was frozen.
|
|
|
|
--- a/embed.fnc
|
|
+++ b/embed.fnc
|
|
@@ -2793,9 +2793,11 @@ s |bool |isa_lookup |NN HV *stash|NN con
|
|
#endif
|
|
|
|
#if defined(PERL_IN_LOCALE_C)
|
|
+# ifdef USE_LOCALE
|
|
sn |const char*|category_name |const int category
|
|
s |const char*|switch_category_locale_to_template|const int switch_category|const int template_category|NULLOK const char * template_locale
|
|
s |void |restore_switched_locale|const int category|NULLOK const char * const original_locale
|
|
+# endif
|
|
# ifdef HAS_NL_LANGINFO
|
|
sn |const char*|my_nl_langinfo|const nl_item item|bool toggle
|
|
# else
|
|
--- a/embed.h
|
|
+++ b/embed.h
|
|
@@ -1796,16 +1796,16 @@
|
|
#define unshare_hek_or_pvn(a,b,c,d) S_unshare_hek_or_pvn(aTHX_ a,b,c,d)
|
|
# endif
|
|
# if defined(PERL_IN_LOCALE_C)
|
|
-#define category_name S_category_name
|
|
-#define restore_switched_locale(a,b) S_restore_switched_locale(aTHX_ a,b)
|
|
#define save_to_buffer S_save_to_buffer
|
|
-#define switch_category_locale_to_template(a,b,c) S_switch_category_locale_to_template(aTHX_ a,b,c)
|
|
# if defined(USE_LOCALE)
|
|
+#define category_name S_category_name
|
|
#define new_collate(a) S_new_collate(aTHX_ a)
|
|
#define new_ctype(a) S_new_ctype(aTHX_ a)
|
|
#define new_numeric(a) S_new_numeric(aTHX_ a)
|
|
+#define restore_switched_locale(a,b) S_restore_switched_locale(aTHX_ a,b)
|
|
#define set_numeric_radix(a) S_set_numeric_radix(aTHX_ a)
|
|
#define stdize_locale(a) S_stdize_locale(aTHX_ a)
|
|
+#define switch_category_locale_to_template(a,b,c) S_switch_category_locale_to_template(aTHX_ a,b,c)
|
|
# if defined(USE_POSIX_2008_LOCALE)
|
|
#define emulate_setlocale S_emulate_setlocale
|
|
# endif
|
|
--- a/locale.c
|
|
+++ b/locale.c
|
|
@@ -1264,6 +1264,7 @@ S_locking_setlocale(pTHX_
|
|
}
|
|
|
|
#endif
|
|
+#ifdef USE_LOCALE
|
|
|
|
STATIC void
|
|
S_set_numeric_radix(pTHX_ const bool use_locale)
|
|
@@ -1299,6 +1300,10 @@ S_set_numeric_radix(pTHX_ const bool use
|
|
}
|
|
|
|
# endif
|
|
+#else
|
|
+
|
|
+ PERL_UNUSED_ARG(use_locale);
|
|
+
|
|
#endif /* USE_LOCALE_NUMERIC and can find the radix char */
|
|
|
|
}
|
|
@@ -1481,7 +1486,6 @@ S_new_ctype(pTHX_ const char *newctype)
|
|
|
|
#ifndef USE_LOCALE_CTYPE
|
|
|
|
- PERL_ARGS_ASSERT_NEW_CTYPE;
|
|
PERL_UNUSED_ARG(newctype);
|
|
PERL_UNUSED_CONTEXT;
|
|
|
|
@@ -1994,6 +1998,8 @@ S_new_collate(pTHX_ const char *newcoll)
|
|
|
|
}
|
|
|
|
+#endif
|
|
+
|
|
#ifdef WIN32
|
|
|
|
STATIC char *
|
|
@@ -2139,11 +2145,20 @@ Perl_setlocale(const int category, const
|
|
{
|
|
/* This wraps POSIX::setlocale() */
|
|
|
|
+#ifdef NO_LOCALE
|
|
+
|
|
+ PERL_UNUSED_ARG(category);
|
|
+ PERL_UNUSED_ARG(locale);
|
|
+
|
|
+ return "C";
|
|
+
|
|
+#else
|
|
+
|
|
const char * retval;
|
|
const char * newlocale;
|
|
dSAVEDERRNO;
|
|
- DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
|
|
dTHX;
|
|
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
|
|
|
|
#ifdef USE_LOCALE_NUMERIC
|
|
|
|
@@ -2262,6 +2277,8 @@ Perl_setlocale(const int category, const
|
|
|
|
return retval;
|
|
|
|
+#endif
|
|
+
|
|
}
|
|
|
|
PERL_STATIC_INLINE const char *
|
|
@@ -2414,13 +2431,16 @@ S_my_nl_langinfo(const int item, bool to
|
|
dTHX;
|
|
const char * retval;
|
|
|
|
+#ifdef USE_LOCALE_NUMERIC
|
|
+
|
|
/* We only need to toggle into the underlying LC_NUMERIC locale for these
|
|
* two items, and only if not already there */
|
|
if (toggle && (( item != RADIXCHAR && item != THOUSEP)
|
|
|| PL_numeric_underlying))
|
|
- {
|
|
+
|
|
+#endif /* No toggling needed if not using LC_NUMERIC */
|
|
+
|
|
toggle = FALSE;
|
|
- }
|
|
|
|
#if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */
|
|
# if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \
|
|
@@ -2468,6 +2488,8 @@ S_my_nl_langinfo(const int item, bool to
|
|
do_free = TRUE;
|
|
}
|
|
|
|
+# ifdef USE_LOCALE_NUMERIC
|
|
+
|
|
if (toggle) {
|
|
if (PL_underlying_numeric_obj) {
|
|
cur = PL_underlying_numeric_obj;
|
|
@@ -2478,6 +2500,8 @@ S_my_nl_langinfo(const int item, bool to
|
|
}
|
|
}
|
|
|
|
+# endif
|
|
+
|
|
/* We have to save it to a buffer, because the freelocale() just below
|
|
* can invalidate the internal one */
|
|
retval = save_to_buffer(nl_langinfo_l(item, cur),
|
|
@@ -5169,9 +5193,7 @@ Perl_my_strerror(pTHX_ const int errnum)
|
|
LOCALE_UNLOCK;
|
|
|
|
# endif /* End of doesn't have strerror_l */
|
|
-#endif /* End of does have locale messages */
|
|
-
|
|
-#ifdef DEBUGGING
|
|
+# ifdef DEBUGGING
|
|
|
|
if (DEBUG_Lv_TEST) {
|
|
PerlIO_printf(Perl_debug_log, "Strerror returned; saving a copy: '");
|
|
@@ -5179,7 +5201,8 @@ Perl_my_strerror(pTHX_ const int errnum)
|
|
PerlIO_printf(Perl_debug_log, "'\n");
|
|
}
|
|
|
|
-#endif
|
|
+# endif
|
|
+#endif /* End of does have locale messages */
|
|
|
|
SAVEFREEPV(errstr);
|
|
return errstr;
|
|
@@ -5301,10 +5324,17 @@ L<C<Perl_switch_to_global_locale>|perlap
|
|
bool
|
|
Perl_sync_locale()
|
|
{
|
|
+
|
|
+#ifndef USE_LOCALE
|
|
+
|
|
+ return TRUE;
|
|
+
|
|
+#else
|
|
+
|
|
const char * newlocale;
|
|
dTHX;
|
|
|
|
-#ifdef USE_POSIX_2008_LOCALE
|
|
+# ifdef USE_POSIX_2008_LOCALE
|
|
|
|
bool was_in_global_locale = FALSE;
|
|
locale_t cur_obj = uselocale((locale_t) 0);
|
|
@@ -5316,11 +5346,11 @@ Perl_sync_locale()
|
|
* will affect the */
|
|
if (cur_obj == LC_GLOBAL_LOCALE) {
|
|
|
|
-# ifdef HAS_QUERY_LOCALE
|
|
+# ifdef HAS_QUERY_LOCALE
|
|
|
|
do_setlocale_c(LC_ALL, setlocale(LC_ALL, NULL));
|
|
|
|
-# else
|
|
+# else
|
|
|
|
unsigned int i;
|
|
|
|
@@ -5330,17 +5360,17 @@ Perl_sync_locale()
|
|
do_setlocale_r(categories[i], setlocale(categories[i], NULL));
|
|
}
|
|
|
|
-# endif
|
|
+# endif
|
|
|
|
was_in_global_locale = TRUE;
|
|
}
|
|
|
|
-#else
|
|
+# else
|
|
|
|
bool was_in_global_locale = TRUE;
|
|
|
|
-#endif
|
|
-#ifdef USE_LOCALE_CTYPE
|
|
+# endif
|
|
+# ifdef USE_LOCALE_CTYPE
|
|
|
|
newlocale = savepv(do_setlocale_c(LC_CTYPE, NULL));
|
|
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
|
|
@@ -5349,8 +5379,8 @@ Perl_sync_locale()
|
|
new_ctype(newlocale);
|
|
Safefree(newlocale);
|
|
|
|
-#endif /* USE_LOCALE_CTYPE */
|
|
-#ifdef USE_LOCALE_COLLATE
|
|
+# endif /* USE_LOCALE_CTYPE */
|
|
+# ifdef USE_LOCALE_COLLATE
|
|
|
|
newlocale = savepv(do_setlocale_c(LC_COLLATE, NULL));
|
|
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
|
|
@@ -5359,8 +5389,8 @@ Perl_sync_locale()
|
|
new_collate(newlocale);
|
|
Safefree(newlocale);
|
|
|
|
-#endif
|
|
-#ifdef USE_LOCALE_NUMERIC
|
|
+# endif
|
|
+# ifdef USE_LOCALE_NUMERIC
|
|
|
|
newlocale = savepv(do_setlocale_c(LC_NUMERIC, NULL));
|
|
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
|
|
@@ -5369,9 +5399,12 @@ Perl_sync_locale()
|
|
new_numeric(newlocale);
|
|
Safefree(newlocale);
|
|
|
|
-#endif /* USE_LOCALE_NUMERIC */
|
|
+# endif /* USE_LOCALE_NUMERIC */
|
|
|
|
return was_in_global_locale;
|
|
+
|
|
+#endif
|
|
+
|
|
}
|
|
|
|
#if defined(DEBUGGING) && defined(USE_LOCALE)
|
|
--- a/makedef.pl
|
|
+++ b/makedef.pl
|
|
@@ -574,6 +574,9 @@ unless ($define{USE_LOCALE_COLLATE}) {
|
|
PL_collxfrm_mult
|
|
Perl_sv_collxfrm
|
|
Perl_sv_collxfrm_flags
|
|
+ PL_strxfrm_NUL_replacement
|
|
+ PL_strxfrm_is_behaved
|
|
+ PL_strxfrm_max_cp
|
|
);
|
|
}
|
|
|
|
@@ -583,6 +586,9 @@ unless ($define{USE_LOCALE_NUMERIC}) {
|
|
PL_numeric_name
|
|
PL_numeric_radix_sv
|
|
PL_numeric_standard
|
|
+ PL_numeric_underlying
|
|
+ PL_numeric_underlying_is_standard
|
|
+ PL_underlying_numeric_obj
|
|
);
|
|
}
|
|
|
|
--- a/perl.h
|
|
+++ b/perl.h
|
|
@@ -5656,6 +5656,9 @@ typedef struct am_table_short AMTS;
|
|
# define IN_LC_COMPILETIME(category) 0
|
|
# define IN_LC_RUNTIME(category) 0
|
|
# define IN_LC(category) 0
|
|
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
|
|
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send)
|
|
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c)
|
|
#endif
|
|
|
|
|
|
--- a/proto.h
|
|
+++ b/proto.h
|
|
@@ -4886,8 +4886,6 @@ PERL_CALLCONV SV* Perl_hfree_next_entry(
|
|
assert(hv); assert(indexp)
|
|
#endif
|
|
#if defined(PERL_IN_LOCALE_C)
|
|
-STATIC const char* S_category_name(const int category);
|
|
-STATIC void S_restore_switched_locale(pTHX_ const int category, const char * const original_locale);
|
|
#ifndef PERL_NO_INLINE_FUNCTIONS
|
|
PERL_STATIC_INLINE const char * S_save_to_buffer(const char * string, char **buf, Size_t *buf_size, const Size_t offset)
|
|
__attribute__warn_unused_result__;
|
|
@@ -4895,17 +4893,19 @@ PERL_STATIC_INLINE const char * S_save_t
|
|
assert(buf_size)
|
|
#endif
|
|
|
|
-STATIC const char* S_switch_category_locale_to_template(pTHX_ const int switch_category, const int template_category, const char * template_locale);
|
|
# if defined(USE_LOCALE)
|
|
+STATIC const char* S_category_name(const int category);
|
|
STATIC void S_new_collate(pTHX_ const char* newcoll);
|
|
STATIC void S_new_ctype(pTHX_ const char* newctype);
|
|
#define PERL_ARGS_ASSERT_NEW_CTYPE \
|
|
assert(newctype)
|
|
STATIC void S_new_numeric(pTHX_ const char* newnum);
|
|
+STATIC void S_restore_switched_locale(pTHX_ const int category, const char * const original_locale);
|
|
STATIC void S_set_numeric_radix(pTHX_ const bool use_locale);
|
|
STATIC char* S_stdize_locale(pTHX_ char* locs);
|
|
#define PERL_ARGS_ASSERT_STDIZE_LOCALE \
|
|
assert(locs)
|
|
+STATIC const char* S_switch_category_locale_to_template(pTHX_ const int switch_category, const int template_category, const char * template_locale);
|
|
# if defined(USE_POSIX_2008_LOCALE)
|
|
STATIC const char* S_emulate_setlocale(const int category, const char* locale, unsigned int index, const bool is_index_valid);
|
|
# endif
|
|
--- a/sv.c
|
|
+++ b/sv.c
|
|
@@ -13330,10 +13330,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const s
|
|
|
|
SvTAINT(sv);
|
|
|
|
+#ifdef USE_LOCALE_NUMERIC
|
|
+
|
|
if (lc_numeric_set) {
|
|
RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to
|
|
save/restore each iteration. */
|
|
}
|
|
+
|
|
+#endif
|
|
+
|
|
}
|
|
|
|
/* =========================================================================
|
|
--- a/t/lib/warnings/regexec
|
|
+++ b/t/lib/warnings/regexec
|
|
@@ -215,6 +215,10 @@ Use of \b{} or \B{} for non-UTF-8 locale
|
|
Use of \b{} or \B{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 17.
|
|
########
|
|
# NAME (?[ ]) in non-UTF-8 locale
|
|
+require '../loc_tools.pl';
|
|
+unless (locales_enabled()) {
|
|
+ print("SKIPPED\n# locales not available\n"),exit;
|
|
+}
|
|
eval { require POSIX; POSIX->import("locale_h") };
|
|
if ($@) {
|
|
print("SKIPPED\n# no POSIX\n"),exit;
|
|
@@ -229,14 +233,14 @@ setlocale(&POSIX::LC_CTYPE, "C");
|
|
":" =~ /(?[ \: ])/;
|
|
no warnings 'locale';
|
|
EXPECT
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 9.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 9.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 10.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 10.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 11.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 11.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 12.
|
|
-Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 12.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 13.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 13.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 14.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 14.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 15.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 15.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 16.
|
|
+Use of (?[ ]) for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 16.
|
|
########
|
|
# NAME (?[ ]) in UTF-8 locale
|
|
require '../loc_tools.pl';
|