This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Add checks for improper locale
authorKarl Williamson <khw@cpan.org>
Sun, 31 Dec 2017 16:49:46 +0000 (09:49 -0700)
committerKarl Williamson <khw@cpan.org>
Mon, 1 Jan 2018 19:37:50 +0000 (12:37 -0700)
There has been code to check that the new locale is compatible with
ASCII when switching to one; this commit expands those checks.  A locale
that isn't ASCII-compatible doesn't play well with Perl.

locale.c

index 3756f5a..ed49160 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -568,10 +568,19 @@ S_new_ctype(pTHX_ const char *newctype)
             if (    check_for_problems
                 && (isGRAPH_A(i) || isBLANK_A(i) || i == '\n'))
             {
             if (    check_for_problems
                 && (isGRAPH_A(i) || isBLANK_A(i) || i == '\n'))
             {
-                if ((    isALPHANUMERIC_A(i) && ! isALPHANUMERIC_LC(i))
-                     || (isPUNCT_A(i) && ! isPUNCT_LC(i))
-                     || (isBLANK_A(i) && ! isBLANK_LC(i))
-                     || (i == '\n' && ! isCNTRL_LC(i)))
+                if (   cBOOL(isalnum(i)) != cBOOL(isALPHANUMERIC(i))
+                    || cBOOL(isalpha(i)) != cBOOL(isALPHA_A(i))
+                    || cBOOL(isdigit(i)) != cBOOL(isDIGIT_A(i))
+                    || cBOOL(isgraph(i)) != cBOOL(isGRAPH_A(i))
+                    || cBOOL(islower(i)) != cBOOL(isLOWER_A(i))
+                    || cBOOL(isprint(i)) != cBOOL(isPRINT_A(i))
+                    || cBOOL(ispunct(i)) != cBOOL(isPUNCT_A(i))
+                    || cBOOL(isspace(i)) != cBOOL(isSPACE_A(i))
+                    || cBOOL(isupper(i)) != cBOOL(isUPPER_A(i))
+                    || cBOOL(isxdigit(i))!= cBOOL(isXDIGIT_A(i))
+                    || tolower(i) != (int) toLOWER_A(i)
+                    || toupper(i) != (int) toUPPER_A(i)
+                    || (i == '\n' && ! isCNTRL_LC(i)))
                 {
                     if (bad_count) {    /* Separate multiple entries with a
                                            blank */
                 {
                     if (bad_count) {    /* Separate multiple entries with a
                                            blank */