This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Fix bug in parsing a locale
authorKarl Williamson <khw@cpan.org>
Sun, 4 Mar 2018 02:21:03 +0000 (19:21 -0700)
committerKarl Williamson <khw@cpan.org>
Sun, 4 Mar 2018 02:55:58 +0000 (19:55 -0700)
This was not handling the case where there is a semi-colon separated
list of individual locales, except the last one had no trailing
semi-colon.

Thanks to Sergey Aleynikov for finding this

locale.c
t/run/locale.t

index b53cb37..e778e3b 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -934,15 +934,19 @@ S_emulate_setlocale(const int category,
 
             /* Parse through the locale name */
             name_start = p;
-            while (isGRAPH(*p) && *p != ';') {
+            while (p < e && *p != ';') {
+                if (! isGRAPH(*p)) {
+                    Perl_croak(aTHX_
+                        "panic: %s: %d: Unexpected character in locale name '%02X",
+                        __FILE__, __LINE__, *(p-1));
+                }
                 p++;
             }
             name_end = p;
 
-            if (*p++ != ';') {
-                Perl_croak(aTHX_
-                    "panic: %s: %d: Unexpected character in locale name '%02X",
-                    __FILE__, __LINE__, *(p-1));
+            /* Space past the semi-colon */
+            if (p < e) {
+                p++;
             }
 
             /* Find the index of the category name in our lists */
@@ -967,7 +971,8 @@ S_emulate_setlocale(const int category,
                 }
 
                 assert(category == LC_ALL);
-                individ_locale = Perl_form(aTHX_ "%.*s", (int) (p - s), s);
+                individ_locale = Perl_form(aTHX_ "%.*s",
+                                    (int) (name_end - name_start), name_start);
                 if (! emulate_setlocale(categories[i], individ_locale, i, TRUE))
                 {
                     return NULL;
index 267279c..cec5b31 100644 (file)
@@ -427,7 +427,18 @@ EOF
 
     }
 
+    {
+        fresh_perl(<<"EOF",
+                use locale;
+                use POSIX;
+                POSIX::setlocale(LC_ALL, "LC_NUMERIC=de_DE.utf8;LC_CTYPE=de_DE.utf8;LC_COLLATE=de_DE.utf8;LC_TIME=de_DE.utf8;LC_MESSAGES=de_DE.utf8;LC_MONETARY=de_DE.utf8;LC_ADDRESS=de_DE.utf8;LC_IDENTIFICATION=de_DE.utf8;LC_MEASUREMENT=de_DE.utf8;LC_PAPER=de_DE.utf8;LC_TELEPHONE=de_DE.utf8");
+EOF
+            {});
+        ok ($? == 0, "In complicated LC_ALL, final individ category doesn't need a \';'");
+
+    }
+
 # IMPORTANT: When adding tests before the following line, be sure to update
 # its skip count:
 #       skip("no locale available where LC_NUMERIC makes a difference", ...)
-sub last { 37 }
+sub last { 38 }