/* locale.c
*
- * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- * 2001, 2002, 2003, 2005, 2006, 2007, by Larry Wall and others
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+ * 2002, 2003, 2005, 2006, 2007, 2008 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.
*/
/*
- * A Elbereth Gilthoniel,
- * silivren penna míriel
- * o menel aglar elenath!
- * Na-chaered palan-díriel
- * o galadhremmin ennorath,
- * Fanuilos, le linnathon
- * nef aear, si nef aearon!
+ * A Elbereth Gilthoniel,
+ * silivren penna míriel
+ * o menel aglar elenath!
+ * Na-chaered palan-díriel
+ * o galadhremmin ennorath,
+ * Fanuilos, le linnathon
+ * nef aear, si nef aearon!
+ *
+ * [p.238 of _The Lord of the Rings_, II/i: "Many Meetings"]
*/
/* utility functions for handling locale-specific stuff like what
#define PERL_IN_LOCALE_C
#include "perl.h"
-#ifdef I_LOCALE
-# include <locale.h>
-#endif
-
#ifdef I_LANGINFO
# include <langinfo.h>
#endif
* (1) "xx_YY" if the first argument of setlocale() is not LC_ALL
* (2) "xa_YY xb_YY ..." if the first argument of setlocale() is LC_ALL
* (the space-separated values represent the various sublocales,
- * in some unspecificed order)
+ * in some unspecified order)
*
* In some platforms it has a form like "LC_SOMETHING=Lang_Country.866\n",
* which is harmful for further use of the string in setlocale().
const char * const s = strchr(locs, '=');
bool okay = TRUE;
+ PERL_ARGS_ASSERT_STDIZE_LOCALE;
+
if (s) {
const char * const t = strchr(s, '.');
okay = FALSE;
dVAR;
int i;
+ PERL_ARGS_ASSERT_NEW_CTYPE;
+
for (i = 0; i < 256; i++) {
if (isUPPER_LC(i))
PL_fold_locale[i] = toLOWER_LC(i);
}
#endif /* USE_LOCALE_CTYPE */
+ PERL_ARGS_ASSERT_NEW_CTYPE;
PERL_UNUSED_ARG(newctype);
PERL_UNUSED_CONTEXT;
}
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");
+ if (mult < 1 && !(fa == 0 && fb == 0))
+ Perl_croak(aTHX_ "panic: strxfrm() gets absurd - a => %"UVuf", ab => %"UVuf,
+ (UV) fa, (UV) fb);
PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0;
PL_collxfrm_mult = mult;
}
codeset = nl_langinfo(CODESET);
#endif
if (codeset)
- utf8locale = (Perl_ibcmp(aTHX_ codeset, STR_WITH_LEN("UTF-8")) == 0 ||
- Perl_ibcmp(aTHX_ codeset, STR_WITH_LEN("UTF8") ) == 0);
+ utf8locale = (foldEQ(codeset, STR_WITH_LEN("UTF-8"))
+ || foldEQ(codeset, STR_WITH_LEN("UTF8") ));
#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 = (Perl_ibcmp(aTHX_ lang, STR_WITH_LEN("UTF-8")) == 0 ||
- Perl_ibcmp(aTHX_ lang, STR_WITH_LEN("UTF8") ) == 0);
+ utf8locale = (foldEQ(lang, STR_WITH_LEN("UTF-8"))
+ || foldEQ(lang, STR_WITH_LEN("UTF8") ));
#ifdef USE_LOCALE_CTYPE
if (curctype)
- utf8locale = (Perl_ibcmp(aTHX_ curctype, STR_WITH_LEN("UTF-8")) == 0 ||
- Perl_ibcmp(aTHX_ curctype, STR_WITH_LEN("UTF8") ) == 0);
+ utf8locale = (foldEQ(curctype, STR_WITH_LEN("UTF-8"))
+ || foldEQ(curctype, STR_WITH_LEN("UTF8") ));
#endif
if (lc_all)
- utf8locale = (Perl_ibcmp(aTHX_ lc_all, STR_WITH_LEN("UTF-8")) == 0 ||
- Perl_ibcmp(aTHX_ lc_all, STR_WITH_LEN("UTF8") ) == 0);
+ utf8locale = (foldEQ(lc_all, STR_WITH_LEN("UTF-8"))
+ || foldEQ(lc_all, STR_WITH_LEN("UTF8") ));
}
#endif /* USE_LOCALE */
if (utf8locale)
char *xbuf;
STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
+ PERL_ARGS_ASSERT_MEM_COLLXFRM;
+
/* the first sizeof(collationix) bytes are used by sv_collxfrm(). */
/* the +1 is for the terminating NUL. */
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/