From 592864721e291ca84556155ffae3ec606999edef Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 18 Mar 2021 10:12:58 -0600 Subject: [PATCH] locale.c: Use new macros from the prev commit This should result in Windows boxes now passing the locale sanity checks. Previously that failure would cause the test suite tests to be skipped, and warnings generated to Windows users that actually were invalid, as the flaws were actually compensated for in other code. --- locale.c | 68 ++++++++++++++++++++++++------------------------------- vms/vms.c | 10 ++++---- 2 files changed, 34 insertions(+), 44 deletions(-) diff --git a/locale.c b/locale.c index 4ddcc482708b..21c8325e99d2 100644 --- a/locale.c +++ b/locale.c @@ -1350,19 +1350,9 @@ S_new_ctype(pTHX_ const char *newctype) unsigned int i; bool maybe_utf8_turkic = FALSE; -#ifdef WIN32 - - /* Windows will have lots of problems because it doesn't adhere to the - * POSIX standard. Macros in handy.h try to compensate */ - bool check_for_problems = FALSE; - -#else - /* Don't check for problems if we are suppressing the warnings */ bool check_for_problems = ckWARN_d(WARN_LOCALE) || UNLIKELY(DEBUG_L_TEST); -#endif - PERL_ARGS_ASSERT_NEW_CTYPE; /* We will replace any bad locale warning with 1) nothing if the new one is @@ -1389,7 +1379,7 @@ S_new_ctype(pTHX_ const char *newctype) #else - if (toupper('i') == 'i' && tolower('I') == 'I') { + if (toU8_UPPER_LC('i') == 'i' && toU8_LOWER_LC('I') == 'I') { #endif check_for_problems = TRUE; @@ -1411,10 +1401,10 @@ S_new_ctype(pTHX_ const char *newctype) for (i = 0; i < 256; i++) { if (! PL_in_utf8_CTYPE_locale) { - if (isupper(i)) - PL_fold_locale[i] = (U8) tolower(i); - else if (islower(i)) - PL_fold_locale[i] = (U8) toupper(i); + if (isU8_UPPER_LC(i)) + PL_fold_locale[i] = (U8) toU8_LOWER_LC(i); + else if (isU8_LOWER_LC(i)) + PL_fold_locale[i] = (U8) toU8_UPPER_LC(i); else PL_fold_locale[i] = (U8) i; } @@ -1451,77 +1441,77 @@ S_new_ctype(pTHX_ const char *newctype) } /* Check each possibe class */ - if (UNLIKELY(cBOOL(isalnum(i)) != cBOOL(isALPHANUMERIC_A(i)))) { + if (UNLIKELY(cBOOL(isU8_ALPHANUMERIC_LC(i)) != cBOOL(isALPHANUMERIC_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isalnum('%s') unexpectedly is %d\n", - name, cBOOL(isalnum(i)))); + name, cBOOL(isU8_ALPHANUMERIC_LC(i)))); } - if (UNLIKELY(cBOOL(isalpha(i)) != cBOOL(isALPHA_A(i)))) { + if (UNLIKELY(cBOOL(isU8_ALPHA_LC(i)) != cBOOL(isALPHA_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isalpha('%s') unexpectedly is %d\n", - name, cBOOL(isalpha(i)))); + name, cBOOL(isU8_ALPHA_LC(i)))); } - if (UNLIKELY(cBOOL(isdigit(i)) != cBOOL(isDIGIT_A(i)))) { + if (UNLIKELY(cBOOL(isU8_DIGIT_LC(i)) != cBOOL(isDIGIT_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isdigit('%s') unexpectedly is %d\n", - name, cBOOL(isdigit(i)))); + name, cBOOL(isU8_DIGIT_LC(i)))); } - if (UNLIKELY(cBOOL(isgraph(i)) != cBOOL(isGRAPH_A(i)))) { + if (UNLIKELY(cBOOL(isU8_GRAPH_LC(i)) != cBOOL(isGRAPH_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isgraph('%s') unexpectedly is %d\n", - name, cBOOL(isgraph(i)))); + name, cBOOL(isU8_GRAPH_LC(i)))); } - if (UNLIKELY(cBOOL(islower(i)) != cBOOL(isLOWER_A(i)))) { + if (UNLIKELY(cBOOL(isU8_LOWER_LC(i)) != cBOOL(isLOWER_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "islower('%s') unexpectedly is %d\n", - name, cBOOL(islower(i)))); + name, cBOOL(isU8_LOWER_LC(i)))); } - if (UNLIKELY(cBOOL(isprint(i)) != cBOOL(isPRINT_A(i)))) { + if (UNLIKELY(cBOOL(isU8_PRINT_LC(i)) != cBOOL(isPRINT_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isprint('%s') unexpectedly is %d\n", - name, cBOOL(isprint(i)))); + name, cBOOL(isU8_PRINT_LC(i)))); } - if (UNLIKELY(cBOOL(ispunct(i)) != cBOOL(isPUNCT_A(i)))) { + if (UNLIKELY(cBOOL(isU8_PUNCT_LC(i)) != cBOOL(isPUNCT_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "ispunct('%s') unexpectedly is %d\n", - name, cBOOL(ispunct(i)))); + name, cBOOL(isU8_PUNCT_LC(i)))); } - if (UNLIKELY(cBOOL(isspace(i)) != cBOOL(isSPACE_A(i)))) { + if (UNLIKELY(cBOOL(isU8_SPACE_LC(i)) != cBOOL(isSPACE_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isspace('%s') unexpectedly is %d\n", - name, cBOOL(isspace(i)))); + name, cBOOL(isU8_SPACE_LC(i)))); } - if (UNLIKELY(cBOOL(isupper(i)) != cBOOL(isUPPER_A(i)))) { + if (UNLIKELY(cBOOL(isU8_UPPER_LC(i)) != cBOOL(isUPPER_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isupper('%s') unexpectedly is %d\n", - name, cBOOL(isupper(i)))); + name, cBOOL(isU8_UPPER_LC(i)))); } - if (UNLIKELY(cBOOL(isxdigit(i))!= cBOOL(isXDIGIT_A(i)))) { + if (UNLIKELY(cBOOL(isU8_XDIGIT_LC(i))!= cBOOL(isXDIGIT_A(i)))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "isxdigit('%s') unexpectedly is %d\n", - name, cBOOL(isxdigit(i)))); + name, cBOOL(isU8_XDIGIT_LC(i)))); } - if (UNLIKELY(tolower(i) != (int) toLOWER_A(i))) { + if (UNLIKELY(toU8_LOWER_LC(i) != (int) toLOWER_A(i))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "tolower('%s')=0x%x instead of the expected 0x%x\n", - name, tolower(i), (int) toLOWER_A(i))); + name, toU8_LOWER_LC(i), (int) toLOWER_A(i))); } - if (UNLIKELY(toupper(i) != (int) toUPPER_A(i))) { + if (UNLIKELY(toU8_UPPER_LC(i) != (int) toUPPER_A(i))) { is_bad = TRUE; DEBUG_L(PerlIO_printf(Perl_debug_log, "toupper('%s')=0x%x instead of the expected 0x%x\n", - name, toupper(i), (int) toUPPER_A(i))); + name, toU8_UPPER_LC(i), (int) toUPPER_A(i))); } if (UNLIKELY((i == '\n' && ! isCNTRL_LC(i)))) { is_bad = TRUE; diff --git a/vms/vms.c b/vms/vms.c index 08cb52e463ea..502d6b47a711 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -5659,7 +5659,7 @@ int_rmsexpand if (!DECC_EFS_CASE_PRESERVE) { char * tbuf; for (tbuf = rms_get_fna(myfab, mynam); *tbuf; tbuf++) - if (islower(*tbuf)) { haslower = 1; break; } + if (isU8_LOWER_LC(*tbuf)) { haslower = 1; break; } } /* Is a long or a short name expected */ @@ -6281,7 +6281,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) #endif for (cp = trndir; *cp; cp++) - if (islower(*cp)) { haslower = 1; break; } + if (isU8_LOWER_LC(*cp)) { haslower = 1; break; } if (!((sts = sys$parse(&dirfab)) & STS$K_SUCCESS)) { if ((dirfab.fab$l_sts == RMS$_DIR) || (dirfab.fab$l_sts == RMS$_DNF) || @@ -9490,7 +9490,7 @@ mp_expand_wild_cards(pTHX_ char *item, struct list_item **head, */ if (!DECC_EFS_CASE_PRESERVE) { for (c = string; *c; ++c) - if (isupper(*c)) + if (isUPPER_L1(*c)) *c = toLOWER_L1(*c); } if (isunix) trim_unixpath(string,item,1); @@ -13638,7 +13638,7 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, */ if (!DECC_EFS_CASE_PRESERVE) { for (cp = filespec; *cp; cp++) - if (islower(*cp)) { haslower = 1; break; } + if (isU8_LOWER_LC(*cp)) { haslower = 1; break; } if (haslower) __mystrtolower(rslt); } @@ -13789,7 +13789,7 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf, */ if (!DECC_EFS_CASE_PRESERVE) { for (cp = filespec; *cp; cp++) - if (islower(*cp)) { haslower = 1; break; } + if (isU8_LOWER_LC(*cp)) { haslower = 1; break; } if (haslower) __mystrtolower(outbuf); }