summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <khw@cpan.org>2015-03-19 13:06:27 -0600
committerKarl Williamson <khw@cpan.org>2015-03-19 16:18:00 -0600
commit67d796aebd5882a4f28c5b95fb63f198a160c844 (patch)
tree283fb7684f5af5c98d29810b8855f9a55451bfdf
parent0c36c41be6ceb31ab6c2cb9eaebf3d1fd7746e21 (diff)
downloadperl-67d796aebd5882a4f28c5b95fb63f198a160c844.tar.gz
Change some locale manipulation macros in prep for API
This changes the way some of the current internal-only macros are named and used in order to simplify things and minimize what gets exposed as part of the API. Although these have not been listed as publicly available, it costs essentially nothing to keep the old names around in case someone was illegally using them.
-rw-r--r--dump.c8
-rw-r--r--ext/POSIX/POSIX.xs21
-rw-r--r--numeric.c8
-rw-r--r--perl.h131
-rw-r--r--pp_ctl.c3
-rw-r--r--sv.c5
-rw-r--r--toke.c4
7 files changed, 99 insertions, 81 deletions
diff --git a/dump.c b/dump.c
index 2e0bc019cf..0629514d84 100644
--- a/dump.c
+++ b/dump.c
@@ -477,9 +477,9 @@ Perl_sv_peek(pTHX_ SV *sv)
}
}
else if (SvNOKp(sv)) {
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
}
else if (SvIOKp(sv)) {
if (SvIsUV(sv))
@@ -1575,9 +1575,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
|| type == SVt_NV) {
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
}
if (SvROK(sv)) {
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 5a2c30622f..43fad83ce4 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -2002,7 +2002,8 @@ localeconv()
/* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
* LC_MONETARY is already in the correct locale */
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
RETVAL = newHV();
sv_2mortal((SV*)RETVAL);
@@ -2055,7 +2056,7 @@ localeconv()
integers++;
}
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#endif /* HAS_LOCALECONV */
OUTPUT:
RETVAL
@@ -2079,7 +2080,7 @@ setlocale(category, locale = 0)
}
# ifdef LC_ALL
else if (category == LC_ALL) {
- SET_NUMERIC_LOCAL();
+ SET_NUMERIC_UNDERLYING();
}
# endif
}
@@ -2101,8 +2102,8 @@ setlocale(category, locale = 0)
/* Save retval since subsequent setlocale() calls may overwrite it. */
retval = savepv(retval);
- /* For locale == 0, we may have switched to NUMERIC_LOCAL. Switch back
- * */
+ /* For locale == 0, we may have switched to NUMERIC_UNDERLYING. Switch
+ * back */
if (locale == 0) {
SET_NUMERIC_STANDARD();
XSRETURN_PV(retval);
@@ -3188,7 +3189,8 @@ strtod(str)
double num;
char *unparsed;
PPCODE:
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtod(str, &unparsed);
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
@@ -3198,7 +3200,7 @@ strtod(str)
else
PUSHs(&PL_sv_undef);
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#ifdef HAS_STRTOLD
@@ -3209,7 +3211,8 @@ strtold(str)
long double num;
char *unparsed;
PPCODE:
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtold(str, &unparsed);
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
@@ -3219,7 +3222,7 @@ strtold(str)
else
PUSHs(&PL_sv_undef);
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#endif
diff --git a/numeric.c b/numeric.c
index a13a5e236e..e97bc26165 100644
--- a/numeric.c
+++ b/numeric.c
@@ -522,7 +522,8 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
if (IN_LC(LC_NUMERIC)) {
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
if (PL_numeric_radix_sv) {
STRLEN len;
const char * const radix = SvPV(PL_numeric_radix_sv, len);
@@ -1209,7 +1210,8 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
{
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
const char *standard = NULL, *local = NULL;
bool use_standard_radix;
@@ -1232,7 +1234,7 @@ Perl_my_atof(pTHX_ const char* s)
Perl_atof2(s, x);
if (use_standard_radix)
- SET_NUMERIC_LOCAL();
+ SET_NUMERIC_UNDERLYING();
}
else
Perl_atof2(s, x);
diff --git a/perl.h b/perl.h
index 7313de0c5f..5477d8aac8 100644
--- a/perl.h
+++ b/perl.h
@@ -5866,45 +5866,33 @@ typedef struct am_table_short AMTS;
#ifdef USE_LOCALE_NUMERIC
-/* These macros are for toggling between the underlying locale (LOCAL) and the
- * C locale. */
-
-/* The first set makes sure that the locale is set to C unless within a 'use
- * locale's scope; otherwise to the default locale. A function pointer is
- * used, which can be declared separately by
- * DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED, followed by the actual
- * setting (using STORE_LC_NUMERIC_SET_TO_NEEDED()), or the two can be combined
- * into one call DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED().
- * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before
- * these were called */
+/* These macros are for toggling between the underlying locale (UNDERLYING or
+ * LOCAL) and the C locale (STANDARD). */
#define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard)
/* We can lock the category to stay in the C locale, making requests to the
* contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */
-#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2)
-
-#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
- void (*_restore_LC_NUMERIC_function)(pTHX) = NULL;
-
-#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
- if (IN_LC(LC_NUMERIC)) { \
- if (_NOT_IN_NUMERIC_LOCAL) { \
- set_numeric_local(); \
- _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
- } \
- } \
- else { \
- if (_NOT_IN_NUMERIC_STANDARD) { \
- SET_NUMERIC_STANDARD(); \
- _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
- } \
+#define _NOT_IN_NUMERIC_UNDERLYING \
+ (! PL_numeric_local && PL_numeric_standard < 2)
+
+#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
+ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
+
+#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ if (IN_LC(LC_NUMERIC)) { \
+ if (_NOT_IN_NUMERIC_UNDERLYING) { \
+ set_numeric_local(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ } \
+ } \
+ else { \
+ if (_NOT_IN_NUMERIC_STANDARD) { \
+ SET_NUMERIC_STANDARD(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
+ } \
}
-#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \
- DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \
- STORE_LC_NUMERIC_SET_TO_NEEDED();
-
#define RESTORE_LC_NUMERIC() \
if (_restore_LC_NUMERIC_function) { \
_restore_LC_NUMERIC_function(aTHX); \
@@ -5916,65 +5904,88 @@ typedef struct am_table_short AMTS;
STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \
} STMT_END
-#define SET_NUMERIC_LOCAL() \
- STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \
+#define SET_NUMERIC_UNDERLYING() \
+ STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \
set_numeric_local(); } STMT_END
/* The rest of these LC_NUMERIC macros toggle to one or the other state, with
* the RESTORE_foo ones called to switch back, but only if need be */
-#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
- bool _was_local = _NOT_IN_NUMERIC_STANDARD; \
+#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \
+ bool _was_local = _NOT_IN_NUMERIC_STANDARD; \
if (_was_local) set_numeric_standard();
/* Doesn't change to underlying locale unless within the scope of some form of
* 'use locale'. This is the usual desired behavior. */
-#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
- bool _was_standard = _NOT_IN_NUMERIC_LOCAL \
- && IN_LC(LC_NUMERIC); \
+#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \
+ bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \
+ && IN_LC(LC_NUMERIC); \
if (_was_standard) set_numeric_local();
/* Rarely, we want to change to the underlying locale even outside of 'use
* locale'. This is principally in the POSIX:: functions */
-#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
- bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \
- if (_was_standard) set_numeric_local();
+#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \
+ if (_NOT_IN_NUMERIC_UNDERLYING) { \
+ set_numeric_local(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ }
/* Lock to the C locale until unlock is called */
-#define LOCK_NUMERIC_STANDARD() \
- (__ASSERT_(PL_numeric_standard) \
+#define LOCK_LC_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard) \
PL_numeric_standard = 2)
-#define UNLOCK_NUMERIC_STANDARD() \
- (__ASSERT_(PL_numeric_standard == 2) \
+#define UNLOCK_LC_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard == 2) \
PL_numeric_standard = 1)
-#define RESTORE_NUMERIC_LOCAL() \
+#define RESTORE_LC_NUMERIC_UNDERLYING() \
if (_was_local) set_numeric_local();
-#define RESTORE_NUMERIC_STANDARD() \
- if (_was_standard) SET_NUMERIC_STANDARD();
+#define RESTORE_LC_NUMERIC_STANDARD() \
+ if (_restore_LC_NUMERIC_function) { \
+ _restore_LC_NUMERIC_function(aTHX); \
+ }
#else /* !USE_LOCALE_NUMERIC */
-#define SET_NUMERIC_STANDARD() /**/
-#define SET_NUMERIC_LOCAL() /**/
+#define SET_LC_NUMERIC_STANDARD() /**/
+#define SET_LC_NUMERIC_UNDERLYING()
#define IS_NUMERIC_RADIX(a, b) (0)
-#define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/
-#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/
-#define STORE_NUMERIC_STANDARD_FORCE_LOCAL()
-#define RESTORE_NUMERIC_LOCAL() /**/
-#define RESTORE_NUMERIC_STANDARD() /**/
-#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED
+#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
+#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
+#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+#define RESTORE_LC_NUMERIC_UNDERLYING()
+#define RESTORE_LC_NUMERIC_STANDARD() /**/
+#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
#define STORE_LC_NUMERIC_SET_TO_NEEDED()
-#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED()
#define RESTORE_LC_NUMERIC()
-#define LOCK_NUMERIC_STANDARD()
-#define UNLOCK_NUMERIC_STANDARD()
+#define LOCK_LC_NUMERIC_STANDARD()
+#define UNLOCK_LC_NUMERIC_STANDARD()
#endif /* !USE_LOCALE_NUMERIC */
#define Atof my_atof
+/* Back-compat names */
+#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+#define LOCK_NUMERIC_STANDARD() LOCK_LC_NUMERIC_STANDARD()
+#define RESTORE_NUMERIC_LOCAL() RESTORE_LC_NUMERIC_UNDERLYING()
+#define RESTORE_NUMERIC_STANDARD() RESTORE_LC_NUMERIC_STANDARD()
+#define SET_NUMERIC_LOCAL() SET_NUMERIC_UNDERLYING()
+#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
+#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
+ STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+#define UNLOCK_NUMERIC_STANDARD() UNLOCK_LC_NUMERIC_STANDARD()
+
+
+
#ifdef USE_QUADMATH
# define Perl_strtod(s, e) strtoflt128(s, e)
#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
diff --git a/pp_ctl.c b/pp_ctl.c
index ac0f1bcd3d..672680222f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -824,7 +824,8 @@ PP(pp_formline)
{
Size_t max = SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget));
int len;
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
#ifdef USE_QUADMATH
{
diff --git a/sv.c b/sv.c
index 5c92c0b684..341d591c2f 100644
--- a/sv.c
+++ b/sv.c
@@ -3160,7 +3160,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
#else
{
bool local_radix;
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
local_radix =
PL_numeric_local &&
@@ -11205,7 +11206,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
bool hexfp = FALSE; /* hexadecimal floating point? */
- DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
PERL_UNUSED_ARG(maybe_tainted);
diff --git a/toke.c b/toke.c
index 3b60488de2..610db62490 100644
--- a/toke.c
+++ b/toke.c
@@ -10472,7 +10472,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
floatit = TRUE;
}
if (floatit) {
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
/* terminate the string */
*d = '\0';
if (UNLIKELY(hexfp)) {
@@ -10489,7 +10489,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
} else {
nv = Atof(PL_tokenbuf);
}
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
sv = newSVnv(nv);
}