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

[perl.git] branch blead updated. v5.29.9-10-gef65a74af1

From:
Karl Williamson
Date:
March 21, 2019 16:50
Subject:
[perl.git] branch blead updated. v5.29.9-10-gef65a74af1
Message ID:
E1h70tK-0001uJ-GU@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/ef65a74af186beb93566cf827c5f543f4aa14645?hp=c0227122a5447e00b1f129874141e867a945afc2>

- Log -----------------------------------------------------------------
commit ef65a74af186beb93566cf827c5f543f4aa14645
Author: Karl Williamson <khw@cpan.org>
Date:   Thu Mar 21 09:35:49 2019 -0600

    PATCH: [perl #133880] assertion failure
    
    This was caused by attempting to continue parsing after an error is
    found, and later assuming that what came before was valid.  The fix is
    to put in something valid that's usable until the parse eventually dies
    from what caused this, or some other error.

commit b22e993787de8895a38a87d1fd16646f6653e6eb
Author: Karl Williamson <khw@cpan.org>
Date:   Thu Mar 21 09:02:24 2019 -0600

    locale.c: White-space, comment only
    
    Indent a block newly formed in the previous commit.
    Wrap some too-long lines

commit 70bd6bc82ba64c1d197d3ec823f43c4a454b2920
Author: Karl Williamson <khw@cpan.org>
Date:   Wed Mar 20 22:59:39 2019 -0600

    locale.c: Don't try to recreate the LC_ALL C locale
    
    On threaded perls, we create a locale object for LC_ALL "C" early in the
    startup phase.  When the user asks for that locale, we can just switch
    to it instead of trying to create a new one.
    
    Doing the creation worked, but ended up with a memory leak.  My guess,
    and its only a guess, is that it's a bug in glibc newlocale.c, in which
    it does an early return, not doing proper cleanup, when it discovers it
    can re-use an existing locale without needing to create a new one.
    
    The reason I think its a glibc bug is that the sample one-liner sent
    to me
    
    PERL_DESTRUCT_LEVEL=2 valgrind --leak-check=full ./perl -DLv -Ilib -e'require POSIX;POSIX::setlocale(&POSIX::LC_ALL, "C");' 2>&1 | more
    
    produced a stack output of where the leaked memory had been allocated.
    I put a print immediately after that line, and prints at the points
    where things get freed.  Every allocation was matched by an attempt to
    free it.  But clearly at least one failed.  freelocale() returns void,
    so can't be checked for failing.
    
    Anyway, it's better to try not to create a new locale when we already
    have an existing one, and doing so, as this commit does, causes the leak
    to go away.
    
    No tests are added, as there are plenty of similar tests already in the
    suite, and they all should have been leaking.

commit 19ee3daf45fd9f6312e89aeae0bc6dc8563e6c4a
Author: Karl Williamson <khw@cpan.org>
Date:   Wed Mar 20 22:58:38 2019 -0600

    Add, improve some debugging stmts for -DL (locales)

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

Summary of changes:
 locale.c  | 116 ++++++++++++++++++++++++++++++++++++++++++--------------------
 perl.c    |   5 +++
 t/op/tr.t |   8 ++++-
 toke.c    |   8 +++--
 4 files changed, 97 insertions(+), 40 deletions(-)

diff --git a/locale.c b/locale.c
index 2b123d16ee..8e440cb80d 100644
--- a/locale.c
+++ b/locale.c
@@ -1002,89 +1002,131 @@ S_emulate_setlocale(const int category,
 #  ifdef DEBUGGING
 
     if (DEBUG_Lv_TEST || debug_initialization) {
-        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale now using %p\n", __FILE__, __LINE__, PL_C_locale_obj);
+        PerlIO_printf(Perl_debug_log,
+                      "%s:%d: emulate_setlocale now using %p\n",
+                      __FILE__, __LINE__, PL_C_locale_obj);
     }
 
 #  endif
 
-    /* If we weren't in a thread safe locale, set so that newlocale() below
-     which uses 'old_obj', uses an empty one.  Same for our reserved C object.
-     The latter is defensive coding, so that, even if there is some bug, we
-     will never end up trying to modify either of these, as if passed to
-     newlocale(), they can be. */
-    if (old_obj == LC_GLOBAL_LOCALE || old_obj == PL_C_locale_obj) {
-        old_obj = (locale_t) 0;
-    }
-
-    /* Ready to create a new locale by modification of the exising one */
-    new_obj = newlocale(mask, locale, old_obj);
-
-    if (! new_obj) {
-        dSAVE_ERRNO;
+    /* If we are switching to the LC_ALL C locale, it already exists.  Use
+     * it instead of trying to create a new locale */
+    if (mask == LC_ALL_MASK && isNAME_C_OR_POSIX(locale)) {
 
 #  ifdef DEBUGGING
 
-        if (DEBUG_L_TEST || debug_initialization) {
-            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale creating new object failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log,
+                          "%s:%d: will stay in C object\n", __FILE__, __LINE__);
         }
 
 #  endif
 
-        if (! uselocale(old_obj)) {
+        new_obj = PL_C_locale_obj;
+
+        /* We already had switched to the C locale in preparation for freeing
+         * 'old_obj' */
+        if (old_obj != LC_GLOBAL_LOCALE && old_obj != PL_C_locale_obj) {
+            freelocale(old_obj);
+        }
+    }
+    else {
+        /* If we weren't in a thread safe locale, set so that newlocale() below
+         * which uses 'old_obj', uses an empty one.  Same for our reserved C
+         * object.  The latter is defensive coding, so that, even if there is
+         * some bug, we will never end up trying to modify either of these, as
+         * if passed to newlocale(), they can be. */
+        if (old_obj == LC_GLOBAL_LOCALE || old_obj == PL_C_locale_obj) {
+            old_obj = (locale_t) 0;
+        }
+
+        /* Ready to create a new locale by modification of the exising one */
+        new_obj = newlocale(mask, locale, old_obj);
+
+        if (! new_obj) {
+            dSAVE_ERRNO;
 
 #  ifdef DEBUGGING
 
             if (DEBUG_L_TEST || debug_initialization) {
-                PerlIO_printf(Perl_debug_log, "%s:%d: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+                PerlIO_printf(Perl_debug_log,
+                              "%s:%d: emulate_setlocale creating new object"
+                              " failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
             }
 
 #  endif
 
-        }
-        RESTORE_ERRNO;
-        return NULL;
-    }
+            if (! uselocale(old_obj)) {
 
 #  ifdef DEBUGGING
 
-    if (DEBUG_Lv_TEST || debug_initialization) {
-        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale created %p; should have freed %p\n", __FILE__, __LINE__, new_obj, old_obj);
-    }
+                if (DEBUG_L_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log,
+                                  "%s:%d: switching back failed: %d\n",
+                                  __FILE__, __LINE__, GET_ERRNO);
+                }
 
 #  endif
 
-    /* And switch into it */
-    if (! uselocale(new_obj)) {
-        dSAVE_ERRNO;
+            }
+            RESTORE_ERRNO;
+            return NULL;
+        }
 
 #  ifdef DEBUGGING
 
-        if (DEBUG_L_TEST || debug_initialization) {
-            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale switching to new object failed\n", __FILE__, __LINE__);
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log,
+                          "%s:%d: emulate_setlocale created %p",
+                          __FILE__, __LINE__, new_obj);
+            if (old_obj) {
+                PerlIO_printf(Perl_debug_log,
+                              "; should have freed %p", old_obj);
+            }
+            PerlIO_printf(Perl_debug_log, "\n");
         }
 
 #  endif
 
-        if (! uselocale(old_obj)) {
+        /* And switch into it */
+        if (! uselocale(new_obj)) {
+            dSAVE_ERRNO;
 
 #  ifdef DEBUGGING
 
             if (DEBUG_L_TEST || debug_initialization) {
-                PerlIO_printf(Perl_debug_log, "%s:%d: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+                PerlIO_printf(Perl_debug_log,
+                              "%s:%d: emulate_setlocale switching to new object"
+                              " failed\n", __FILE__, __LINE__);
             }
 
 #  endif
 
+            if (! uselocale(old_obj)) {
+
+#  ifdef DEBUGGING
+
+                if (DEBUG_L_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log,
+                                  "%s:%d: switching back failed: %d\n",
+                                  __FILE__, __LINE__, GET_ERRNO);
+                }
+
+#  endif
+
+            }
+            freelocale(new_obj);
+            RESTORE_ERRNO;
+            return NULL;
         }
-        freelocale(new_obj);
-        RESTORE_ERRNO;
-        return NULL;
     }
 
 #  ifdef DEBUGGING
 
     if (DEBUG_Lv_TEST || debug_initialization) {
-        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale now using %p\n", __FILE__, __LINE__, new_obj);
+        PerlIO_printf(Perl_debug_log,
+                      "%s:%d: emulate_setlocale now using %p\n",
+                      __FILE__, __LINE__, new_obj);
     }
 
 #  endif
diff --git a/perl.c b/perl.c
index 3c49f9650f..cdefa99018 100644
--- a/perl.c
+++ b/perl.c
@@ -1139,11 +1139,16 @@ perl_destruct(pTHXx)
          * below */
         const locale_t old_locale = uselocale(LC_GLOBAL_LOCALE);
         if (old_locale != LC_GLOBAL_LOCALE) {
+            DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                     "%s:%d: Freeing %p\n", __FILE__, __LINE__, old_locale));
             freelocale(old_locale);
         }
     }
 #  ifdef USE_LOCALE_NUMERIC
     if (PL_underlying_numeric_obj) {
+        DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                    "%s:%d: Freeing %p\n", __FILE__, __LINE__,
+                    PL_underlying_numeric_obj));
         freelocale(PL_underlying_numeric_obj);
         PL_underlying_numeric_obj = (locale_t) NULL;
     }
diff --git a/t/op/tr.t b/t/op/tr.t
index 0f74936fdb..47d603d4fd 100644
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use utf8;
 
-plan tests => 300;
+plan tests => 301;
 
 # Test this first before we extend the stack with other operations.
 # This caused an asan failure due to a bad write past the end of the stack.
@@ -1137,6 +1137,12 @@ for ("", nullrocow) {
     [\x{E5CD}-\x{E5DF}\x{EA80}-\x{EAFA}\x{EB0E}-\x{EB8E}\x{EAFB}-\x{EB0D}\x{E5B5}-\x{E5CC}];
 
     is $x, "\x{E5CE}", '[perl #130656]';
+
+}
+
+{
+    fresh_perl_like('y/\x{a00}0-\N{}//', qr/Unknown charname/, { },
+                    'RT #133880 illegal \N{}');
 }
 
 1;
diff --git a/toke.c b/toke.c
index 755740d6c4..9bed338ecc 100644
--- a/toke.c
+++ b/toke.c
@@ -3783,8 +3783,12 @@ S_scan_const(pTHX_ char *start)
 		    }
 		}
 		else /* Here is \N{NAME} but not \N{U+...}. */
-                     if ((res = get_and_check_backslash_N_name_wrapper(s, e)))
-                {
+                     if (! (res = get_and_check_backslash_N_name_wrapper(s, e)))
+                {   /* Failed.  We should die eventually, but for now use a NUL
+                       to keep parsing */
+                    *d++ = '\0';
+                }
+                else {  /* Successfully evaluated the name */
                     STRLEN len;
                     const char *str = SvPV_const(res, len);
                     if (PL_lex_inpat) {

-- 
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