develooper Front page | perl.perl5.changes | Postings from March 2018

[perl.git] branch blead updated. v5.27.9-93-gbee74f4b98

From:
Karl Williamson
Date:
March 4, 2018 02:56
Subject:
[perl.git] branch blead updated. v5.27.9-93-gbee74f4b98
Message ID:
E1esJoh-00010q-Tc@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/bee74f4b9818f0ca72926dd6b4dfdbc6b75c59ef?hp=32128a7f27904b0ac4cc16cc0c5b0f5238cf60fd>

- Log -----------------------------------------------------------------
commit bee74f4b9818f0ca72926dd6b4dfdbc6b75c59ef
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 19:21:03 2018 -0700

    locale.c: Fix bug in parsing a locale
    
    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

commit 6435f98d18bc6192cd7afc7967e7cb106106c995
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 19:17:43 2018 -0700

    locale.c: Check return code
    
    In cases like these, we should give up if the called function fails.

commit 3c76a41273291359254beddc38dcf4f68f72934c
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 19:15:07 2018 -0700

    locale.c: Replace an 'if' by an assert
    
    This should be true if we get to here.

commit 8773126a5a3f0a35e4c429218a51b1af4aefb1c7
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 18:56:25 2018 -0700

    locale.c: Increase debug buffer size
    
    A case was found where this was too small

commit 99fc046c92dcc7832f9434c4fd6770128d88bac1
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 18:54:26 2018 -0700

    locale.c: Rmv spurious Safefree
    
    I misread the documentation, and Perl_form doesn't need its return value
    freed; it's already declared to be temporary, so if this code actually
    got executed, there'd be a wrong pool panic

commit fccac591b585f6b2bdf922b0c6f26a427d5f4cf4
Author: Karl Williamson <khw@cpan.org>
Date:   Sat Mar 3 18:52:07 2018 -0700

    locale.c: Remove redundant SAVE_ERRNO
    
    The errnos were already saved just above

-----------------------------------------------------------------------

Summary of changes:
 locale.c       | 34 ++++++++++++++++++++++------------
 t/run/locale.t | 13 ++++++++++++-
 2 files changed, 34 insertions(+), 13 deletions(-)

diff --git a/locale.c b/locale.c
index d6d91ea2b9..e778e3b124 100644
--- a/locale.c
+++ b/locale.c
@@ -869,7 +869,11 @@ S_emulate_setlocale(const int category,
                                                 && strNE(env_override, ""))
                                                ? env_override
                                                : default_name;
-                    emulate_setlocale(categories[i], this_locale, i, TRUE);
+                    if (! emulate_setlocale(categories[i], this_locale, i, TRUE))
+                    {
+                        Safefree(env_override);
+                        return NULL;
+                    }
 
                     if (strNE(this_locale, default_name)) {
                         did_override = TRUE;
@@ -930,19 +934,24 @@ 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 */
             for (i = 0; i < LC_ALL_INDEX; i++) {
+                char * individ_locale;
 
                 /* Keep going if this isn't the index.  The strnNE() avoids a
                  * Perl_form(), but would fail if ever a category name could be
@@ -961,10 +970,12 @@ S_emulate_setlocale(const int category,
                     goto ready_to_set;
                 }
 
-                if (category == LC_ALL) {
-                    char * individ_locale = Perl_form(aTHX_ "%.*s", (int) (p - s), s);
-                    emulate_setlocale(categories[i], individ_locale, i, TRUE);
-                    Safefree(individ_locale);
+                assert(category == LC_ALL);
+                individ_locale = Perl_form(aTHX_ "%.*s",
+                                    (int) (name_end - name_start), name_start);
+                if (! emulate_setlocale(categories[i], individ_locale, i, TRUE))
+                {
+                    return NULL;
                 }
             }
 
@@ -998,7 +1009,6 @@ S_emulate_setlocale(const int category,
 #  endif
 
         if (! uselocale(old_obj)) {
-            SAVE_ERRNO;
 
 #  ifdef DEBUGGING
 
@@ -5173,7 +5183,7 @@ S_setlocale_debug_string(const int category,        /* category number,
 
     /* initialise to a non-null value to keep it out of BSS and so keep
      * -DPERL_GLOBAL_STRUCT_PRIVATE happy */
-    static char ret[128] = "If you can read this, thank your buggy C"
+    static char ret[256] = "If you can read this, thank your buggy C"
                            " library strlcpy(), and change your hints file"
                            " to undef it";
 
diff --git a/t/run/locale.t b/t/run/locale.t
index 267279c99f..cec5b31c68 100644
--- a/t/run/locale.t
+++ b/t/run/locale.t
@@ -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 }

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About