#define PERL_EXT_POSIX
+#define PERL_EXT
#ifdef NETWARE
#define _POSIX_
#ifdef WIN32
#include <sys/errno2.h>
#endif
-#ifdef I_FLOAT
#include <float.h>
-#endif
#ifdef I_FENV
#if !(defined(__vax__) && defined(__NetBSD__))
#include <fenv.h>
#endif
#endif
-#ifdef I_LIMITS
#include <limits.h>
-#endif
#include <locale.h>
#include <math.h>
#ifdef I_PWD
#include <setjmp.h>
#include <signal.h>
#include <stdarg.h>
-
-#ifdef I_STDDEF
#include <stddef.h>
-#endif
#ifdef I_UNISTD
#include <unistd.h>
#if defined(I_TERMIOS)
#include <termios.h>
#endif
-#ifdef I_STDLIB
#include <stdlib.h>
-#endif
#ifndef __ultrix__
#include <string.h>
#endif
/* The Linux man pages say these are the field names for the structure
* components that are LC_NUMERIC; the rest being LC_MONETARY */
-# define isLC_NUMERIC_STRING(name) (strEQ(name, "decimal_point") \
- || strEQ(name, "thousands_sep") \
+# define isLC_NUMERIC_STRING(name) ( strEQ(name, "decimal_point") \
+ || strEQ(name, "thousands_sep") \
\
/* There should be no harm done \
* checking for this, even if \
perl_tz_env = "";
if (crt_tz_env == NULL)
crt_tz_env = "";
- if (strcmp(perl_tz_env, crt_tz_env) != 0) {
+ if (strNE(perl_tz_env, crt_tz_env)) {
newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
if (newenv != NULL) {
sprintf(newenv, "TZ=%s", perl_tz_env);
#else
struct lconv *lcbuf;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+
/* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
* LC_MONETARY is already in the correct locale */
- DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+# ifdef USE_LOCALE_MONETARY
+
+ const bool is_monetary_utf8 = _is_cur_LC_category_utf8(LC_MONETARY);
+# endif
+# ifdef USE_LOCALE_NUMERIC
+
+ bool is_numeric_utf8;
+
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
+ is_numeric_utf8 = _is_cur_LC_category_utf8(LC_NUMERIC);
+# endif
+
RETVAL = newHV();
sv_2mortal((SV*)RETVAL);
- if ((lcbuf = localeconv())) {
+
+ lcbuf = localeconv();
+
+ if (lcbuf) {
const struct lconv_offset *strings = lconv_strings;
const struct lconv_offset *integers = lconv_integers;
const char *ptr = (const char *) lcbuf;
while (strings->name) {
/* This string may be controlled by either LC_NUMERIC, or
* LC_MONETARY */
- bool is_utf8_locale
-#if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
- = _is_cur_LC_category_utf8((isLC_NUMERIC_STRING(strings->name))
- ? LC_NUMERIC
- : LC_MONETARY);
-#elif defined(USE_LOCALE_NUMERIC)
- = _is_cur_LC_category_utf8(LC_NUMERIC);
-#elif defined(USE_LOCALE_MONETARY)
- = _is_cur_LC_category_utf8(LC_MONETARY);
-#else
- = FALSE;
-#endif
+ const bool is_utf8_locale =
+# if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
+ (isLC_NUMERIC_STRING(strings->name))
+ ? is_numeric_utf8
+ : is_monetary_utf8;
+# elif defined(USE_LOCALE_NUMERIC)
+ is_numeric_utf8;
+# elif defined(USE_LOCALE_MONETARY)
+ is_monetary_utf8;
+# else
+ FALSE;
+# endif
const char *value = *((const char **)(ptr + strings->offset));
if (value && *value) {
+ const STRLEN value_len = strlen(value);
+
+ /* We mark it as UTF-8 if a utf8 locale and is valid and
+ * variant under UTF-8 */
+ const bool is_utf8 = is_utf8_locale
+ && is_utf8_non_invariant_string(
+ (U8*) value,
+ value_len);
(void) hv_store(RETVAL,
- strings->name,
- strlen(strings->name),
- newSVpvn_utf8(
- value,
- strlen(value),
-
- /* We mark it as UTF-8 if a utf8 locale and is
- * valid and variant under UTF-8 */
- is_utf8_locale
- && ! is_utf8_invariant_string((U8 *) value, 0)
- && is_utf8_string((U8 *) value, 0)),
- 0);
+ strings->name,
+ strlen(strings->name),
+ newSVpvn_utf8(value, value_len, is_utf8),
+ 0);
}
strings++;
}
integers++;
}
}
- RESTORE_LC_NUMERIC_STANDARD();
+
+ RESTORE_LC_NUMERIC();
#endif /* HAS_LOCALECONV */
OUTPUT:
RETVAL
const char *s = SvPVX_const(ST(0));
int i = whichsig(s);
- if (i < 0 && _memEQs(s, "SIG"))
+ if (i < 0 && memBEGINs(s, SvCUR(ST(0)), "SIG"))
i = whichsig(s + 3);
if (i < 0) {
if (ckWARN(WARN_SIGNAL))
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtod(str, &unparsed);
+ RESTORE_LC_NUMERIC();
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
else
PUSHs(&PL_sv_undef);
}
- RESTORE_LC_NUMERIC_STANDARD();
#ifdef HAS_STRTOLD
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtold(str, &unparsed);
+ RESTORE_LC_NUMERIC();
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
else
PUSHs(&PL_sv_undef);
}
- RESTORE_LC_NUMERIC_STANDARD();
#endif
/* allowing user-supplied (rather than literal) formats
* is normally frowned upon as a potential security risk;
* but this is part of the API so we have to allow it */
- GCC_DIAG_IGNORE(-Wformat-nonliteral);
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
sv = sv_newmortal();
if (buf) {
STRLEN len = strlen(buf);
sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
- if (SvUTF8(fmt)
- || (! is_utf8_invariant_string((U8*) buf, len)
- && is_utf8_string((U8*) buf, len)
+ if ( SvUTF8(fmt)
+ || ( is_utf8_non_invariant_string((U8*) buf, len)
#ifdef USE_LOCALE_TIME
&& _is_cur_LC_category_utf8(LC_TIME)
+#else /* If can't check directly, at least can see if script is consistent,
+ under UTF-8, which gives us an extra measure of confidence. */
+
+ && isSCRIPT_RUN((const U8 *) buf, buf + len,
+ TRUE, /* Means assume UTF-8 */
+ NULL)
#endif
)) {
SvUTF8_on(sv);
https://perl5.git.perl.org / perl5.git / blobdiff