This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
ss_dup of SAVEt_COP_ARYBASE can use the same code as SAVEt_I8.
[perl5.git]
/
locale.c
diff --git
a/locale.c
b/locale.c
index
9d52244
..
dd3060f
100644
(file)
--- a/
locale.c
+++ b/
locale.c
@@
-1,6
+1,7
@@
/* locale.c
*
/* locale.c
*
- * Copyright (c) 2001-2002, Larry Wall
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@
-17,6
+18,10
@@
* nef aear, si nef aearon!
*/
* nef aear, si nef aearon!
*/
+/* utility functions for handling locale-specific stuff like what
+ * character represents the decimal point.
+ */
+
#include "EXTERN.h"
#define PERL_IN_LOCALE_C
#include "perl.h"
#include "EXTERN.h"
#define PERL_IN_LOCALE_C
#include "perl.h"
@@
-31,6
+36,7
@@
#include "reentr.h"
#include "reentr.h"
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
@@
-47,24
+53,19
@@
STATIC char *
S_stdize_locale(pTHX_ char *locs)
{
STATIC char *
S_stdize_locale(pTHX_ char *locs)
{
- c
har *s
;
+ c
onst char * const s = strchr(locs, '=')
;
bool okay = TRUE;
bool okay = TRUE;
- if ((s = strchr(locs, '='))) {
- char *t;
-
+ if (s) {
+ const char * const t = strchr(s, '.');
okay = FALSE;
okay = FALSE;
- if ((t = strchr(s, '.'))) {
- char *u;
-
- if ((u = strchr(t, '\n'))) {
-
- if (u[1] == 0) {
- STRLEN len = u - s;
- Move(s + 1, locs, len, char);
- locs[len] = 0;
- okay = TRUE;
- }
+ 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;
}
}
}
}
}
}
@@
-74,19
+75,20
@@
S_stdize_locale(pTHX_ char *locs)
return locs;
}
return locs;
}
+#endif
void
Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
void
Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
# ifdef HAS_LOCALECONV
# ifdef HAS_LOCALECONV
-
struct lconv* lc
;
+
const struct lconv* const lc = localeconv()
;
- lc = localeconv();
if (lc && lc->decimal_point) {
if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
SvREFCNT_dec(PL_numeric_radix_sv);
if (lc && lc->decimal_point) {
if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
SvREFCNT_dec(PL_numeric_radix_sv);
- PL_numeric_radix_sv = N
ullsv
;
+ PL_numeric_radix_sv = N
ULL
;
}
else {
if (PL_numeric_radix_sv)
}
else {
if (PL_numeric_radix_sv)
@@
-96,7
+98,7
@@
Perl_set_numeric_radix(pTHX)
}
}
else
}
}
else
- PL_numeric_radix_sv = N
ullsv
;
+ PL_numeric_radix_sv = N
ULL
;
# endif /* HAS_LOCALECONV */
#endif /* USE_LOCALE_NUMERIC */
}
# endif /* HAS_LOCALECONV */
#endif /* USE_LOCALE_NUMERIC */
}
@@
-105,15
+107,14
@@
Perl_set_numeric_radix(pTHX)
* Set up for a new numeric locale.
*/
void
* Set up for a new numeric locale.
*/
void
-Perl_new_numeric(pTHX_ char *newnum)
+Perl_new_numeric(pTHX_ c
onst c
har *newnum)
{
#ifdef USE_LOCALE_NUMERIC
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! newnum) {
if (! newnum) {
- if (PL_numeric_name) {
- Safefree(PL_numeric_name);
- PL_numeric_name = NULL;
- }
+ Safefree(PL_numeric_name);
+ PL_numeric_name = NULL;
PL_numeric_standard = TRUE;
PL_numeric_local = TRUE;
return;
PL_numeric_standard = TRUE;
PL_numeric_local = TRUE;
return;
@@
-122,7
+123,8
@@
Perl_new_numeric(pTHX_ char *newnum)
if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
Safefree(PL_numeric_name);
PL_numeric_name = stdize_locale(savepv(newnum));
if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
Safefree(PL_numeric_name);
PL_numeric_name = stdize_locale(savepv(newnum));
- PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
+ PL_numeric_standard = ((*newnum == 'C' && newnum[1] == '\0')
+ || strEQ(newnum, "POSIX"));
PL_numeric_local = TRUE;
set_numeric_radix();
}
PL_numeric_local = TRUE;
set_numeric_radix();
}
@@
-134,6
+136,7
@@
void
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! PL_numeric_standard) {
setlocale(LC_NUMERIC, "C");
if (! PL_numeric_standard) {
setlocale(LC_NUMERIC, "C");
@@
-149,6
+152,7
@@
void
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! PL_numeric_local) {
setlocale(LC_NUMERIC, PL_numeric_name);
if (! PL_numeric_local) {
setlocale(LC_NUMERIC, PL_numeric_name);
@@
-164,10
+168,10
@@
Perl_set_numeric_local(pTHX)
* Set up for a new ctype locale.
*/
void
* Set up for a new ctype locale.
*/
void
-Perl_new_ctype(pTHX_ char *newctype)
+Perl_new_ctype(pTHX_ c
onst c
har *newctype)
{
#ifdef USE_LOCALE_CTYPE
{
#ifdef USE_LOCALE_CTYPE
-
+ dVAR;
int i;
for (i = 0; i < 256; i++) {
int i;
for (i = 0; i < 256; i++) {
@@
-180,15
+184,18
@@
Perl_new_ctype(pTHX_ char *newctype)
}
#endif /* USE_LOCALE_CTYPE */
}
#endif /* USE_LOCALE_CTYPE */
+ PERL_UNUSED_ARG(newctype);
+ PERL_UNUSED_CONTEXT;
}
/*
* Set up for a new collation locale.
*/
void
}
/*
* Set up for a new collation locale.
*/
void
-Perl_new_collate(pTHX_ char *newcoll)
+Perl_new_collate(pTHX_ c
onst c
har *newcoll)
{
#ifdef USE_LOCALE_COLLATE
{
#ifdef USE_LOCALE_COLLATE
+ dVAR;
if (! newcoll) {
if (PL_collation_name) {
if (! newcoll) {
if (PL_collation_name) {
@@
-206,16
+213,17
@@
Perl_new_collate(pTHX_ char *newcoll)
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = stdize_locale(savepv(newcoll));
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = stdize_locale(savepv(newcoll));
- PL_collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX"));
+ PL_collation_standard = ((*newcoll == 'C' && newcoll[1] == '\0')
+ || strEQ(newcoll, "POSIX"));
{
/* 2: at most so many chars ('a', 'b'). */
/* 50: surely no system expands a char more. */
#define XFRMBUFSIZE (2 * 50)
char xbuf[XFRMBUFSIZE];
{
/* 2: at most so many chars ('a', 'b'). */
/* 50: surely no system expands a char more. */
#define XFRMBUFSIZE (2 * 50)
char xbuf[XFRMBUFSIZE];
- Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE);
- Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE);
- SSize_t mult = fb - fa;
+
const
Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE);
+
const
Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE);
+
const
SSize_t mult = fb - fa;
if (mult < 1)
Perl_croak(aTHX_ "strxfrm() gets absurd");
PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0;
if (mult < 1)
Perl_croak(aTHX_ "strxfrm() gets absurd");
PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0;
@@
-240,6
+248,7
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
*/
#if defined(USE_LOCALE)
*/
#if defined(USE_LOCALE)
+ dVAR;
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
@@
-251,10
+260,10
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
#ifdef __GLIBC__
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
#ifdef __GLIBC__
- char *language = PerlEnv_getenv("LANGUAGE");
+ char *
const
language = PerlEnv_getenv("LANGUAGE");
#endif
#endif
- char *lc_all = PerlEnv_getenv("LC_ALL");
- char *lang = PerlEnv_getenv("LANG");
+ char *
const
lc_all = PerlEnv_getenv("LC_ALL");
+ char *
const
lang = PerlEnv_getenv("LANG");
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
@@
-278,7
+287,7
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
if (! (curctype =
setlocale(LC_CTYPE,
(!done && (lang || PerlEnv_getenv("LC_CTYPE")))
if (! (curctype =
setlocale(LC_CTYPE,
(!done && (lang || PerlEnv_getenv("LC_CTYPE")))
- ? "" : N
ullch
)))
+ ? "" : N
ULL
)))
setlocale_failure = TRUE;
else
curctype = savepv(curctype);
setlocale_failure = TRUE;
else
curctype = savepv(curctype);
@@
-287,7
+296,7
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
if (! (curcoll =
setlocale(LC_COLLATE,
(!done && (lang || PerlEnv_getenv("LC_COLLATE")))
if (! (curcoll =
setlocale(LC_COLLATE,
(!done && (lang || PerlEnv_getenv("LC_COLLATE")))
- ? "" : N
ullch
)))
+ ? "" : N
ULL
)))
setlocale_failure = TRUE;
else
curcoll = savepv(curcoll);
setlocale_failure = TRUE;
else
curcoll = savepv(curcoll);
@@
-296,7
+305,7
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
if (! (curnum =
setlocale(LC_NUMERIC,
(!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
if (! (curnum =
setlocale(LC_NUMERIC,
(!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
- ? "" : N
ullch
)))
+ ? "" : N
ULL
)))
setlocale_failure = TRUE;
else
curnum = savepv(curnum);
setlocale_failure = TRUE;
else
curnum = savepv(curnum);
@@
-335,7
+344,7
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
if (setlocale_failure) {
char *p;
if (setlocale_failure) {
char *p;
- bool locwarn = (printwarn > 1 ||
+
const
bool locwarn = (printwarn > 1 ||
(printwarn &&
(!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
(printwarn &&
(!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
@@
-446,13
+455,13
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
#endif /* ! LC_ALL */
#ifdef USE_LOCALE_CTYPE
#endif /* ! LC_ALL */
#ifdef USE_LOCALE_CTYPE
- curctype = savepv(setlocale(LC_CTYPE, N
ullch
));
+ curctype = savepv(setlocale(LC_CTYPE, N
ULL
));
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- curcoll = savepv(setlocale(LC_COLLATE, N
ullch
));
+ curcoll = savepv(setlocale(LC_COLLATE, N
ULL
));
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- curnum = savepv(setlocale(LC_NUMERIC, N
ullch
));
+ curnum = savepv(setlocale(LC_NUMERIC, N
ULL
));
#endif /* USE_LOCALE_NUMERIC */
}
else {
#endif /* USE_LOCALE_NUMERIC */
}
else {
@@
-487,8
+496,8
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
it overrides LC_MESSAGES for GNU gettext, and it also
can have more than one locale, separated by spaces,
in case you need to know.)
it overrides LC_MESSAGES for GNU gettext, and it also
can have more than one locale, separated by spaces,
in case you need to know.)
- If PL_utf8locale and PL_
wantutf8 (set by -C) are true,
- perl.c:S_parse_body() will turn on the PerlIO :utf8 layer
+ If PL_utf8locale and PL_
unicode (set by -C or by $ENV{PERL_UNICODE})
+
are true,
perl.c:S_parse_body() will turn on the PerlIO :utf8 layer
on STDIN, STDOUT, STDERR, _and_ the default open discipline.
*/
bool utf8locale = FALSE;
on STDIN, STDOUT, STDERR, _and_ the default open discipline.
*/
bool utf8locale = FALSE;
@@
-497,59
+506,49
@@
Perl_init_i18nl10n(pTHX_ int printwarn)
codeset = nl_langinfo(CODESET);
#endif
if (codeset)
codeset = nl_langinfo(CODESET);
#endif
if (codeset)
- utf8locale = (
ibcmp(codeset, "UTF-8", 5
) == 0 ||
-
ibcmp(codeset, "UTF8", 4
) == 0);
+ utf8locale = (
Perl_ibcmp(aTHX_ codeset, STR_WITH_LEN("UTF-8")
) == 0 ||
+
Perl_ibcmp(aTHX_ codeset, STR_WITH_LEN("UTF8")
) == 0);
#if defined(USE_LOCALE)
else { /* nl_langinfo(CODESET) is supposed to correctly
* interpret the locale environment variables,
* but just in case it fails, let's do this manually. */
if (lang)
#if defined(USE_LOCALE)
else { /* nl_langinfo(CODESET) is supposed to correctly
* interpret the locale environment variables,
* but just in case it fails, let's do this manually. */
if (lang)
- utf8locale = (
ibcmp(lang, "UTF-8", 5
) == 0 ||
-
ibcmp(lang, "UTF8", 4
) == 0);
+ utf8locale = (
Perl_ibcmp(aTHX_ lang, STR_WITH_LEN("UTF-8")
) == 0 ||
+
Perl_ibcmp(aTHX_ lang, STR_WITH_LEN("UTF8")
) == 0);
#ifdef USE_LOCALE_CTYPE
if (curctype)
#ifdef USE_LOCALE_CTYPE
if (curctype)
- utf8locale = (
ibcmp(curctype, "UTF-8", 5
) == 0 ||
-
ibcmp(curctype, "UTF8", 4
) == 0);
+ utf8locale = (
Perl_ibcmp(aTHX_ curctype, STR_WITH_LEN("UTF-8")
) == 0 ||
+
Perl_ibcmp(aTHX_ curctype, STR_WITH_LEN("UTF8")
) == 0);
#endif
if (lc_all)
#endif
if (lc_all)
- utf8locale = (
ibcmp(lc_all, "UTF-8", 5
) == 0 ||
-
ibcmp(lc_all, "UTF8", 4
) == 0);
+ utf8locale = (
Perl_ibcmp(aTHX_ lc_all, STR_WITH_LEN("UTF-8")
) == 0 ||
+
Perl_ibcmp(aTHX_ lc_all, STR_WITH_LEN("UTF8")
) == 0);
}
#endif /* USE_LOCALE */
if (utf8locale)
PL_utf8locale = TRUE;
}
}
#endif /* USE_LOCALE */
if (utf8locale)
PL_utf8locale = TRUE;
}
- /* Set PL_
wantutf8 to $ENV{PERL_UTF8_LOCAL
E} if using PerlIO.
+ /* Set PL_
unicode to $ENV{PERL_UNICOD
E} if using PerlIO.
This is an alternative to using the -C command line switch
(the -C if present will override this). */
{
This is an alternative to using the -C command line switch
(the -C if present will override this). */
{
- c
har *p = PerlEnv_getenv("PERL_UTF8_LOCAL
E");
- PL_
wantutf8 = p ? (bool) atoi(p) : FALSE
;
+ c
onst char *p = PerlEnv_getenv("PERL_UNICOD
E");
+ PL_
unicode = p ? parse_unicode_opts(&p) : 0
;
}
#endif
#ifdef USE_LOCALE_CTYPE
}
#endif
#ifdef USE_LOCALE_CTYPE
- if (curctype != NULL)
- Safefree(curctype);
+ Safefree(curctype);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (curcoll != NULL)
- Safefree(curcoll);
+ Safefree(curcoll);
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (curnum != NULL)
- Safefree(curnum);
+ Safefree(curnum);
#endif /* USE_LOCALE_NUMERIC */
return ok;
}
#endif /* USE_LOCALE_NUMERIC */
return ok;
}
-/* Backwards compatibility. */
-int
-Perl_init_i18nl14n(pTHX_ int printwarn)
-{
- return init_i18nl10n(printwarn);
-}
-
#ifdef USE_LOCALE_COLLATE
/*
#ifdef USE_LOCALE_COLLATE
/*
@@
-559,9
+558,11
@@
Perl_init_i18nl14n(pTHX_ int printwarn)
* The real transformed data begins at offset sizeof(collationix).
* Please see sv_collxfrm() to see how this is used.
*/
* The real transformed data begins at offset sizeof(collationix).
* Please see sv_collxfrm() to see how this is used.
*/
+
char *
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
{
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 */
char *xbuf;
STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
@@
-569,7
+570,7
@@
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
/* the +1 is for the terminating NUL. */
xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1;
/* the +1 is for the terminating NUL. */
xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1;
- New
(171,
xbuf, xAlloc, char);
+ New
x(
xbuf, xAlloc, char);
if (! xbuf)
goto bad;
if (! xbuf)
goto bad;
@@
-609,3
+610,12
@@
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
#endif /* USE_LOCALE_COLLATE */
#endif /* USE_LOCALE_COLLATE */
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */