This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Add debugging info
authorKarl Williamson <khw@cpan.org>
Tue, 6 Feb 2018 17:32:07 +0000 (10:32 -0700)
committerKarl Williamson <khw@cpan.org>
Sun, 18 Feb 2018 18:31:07 +0000 (11:31 -0700)
This adds some information to a debugging statement, but mostly it adds
an audit of the utf8ness cache structure, invoked under -DLv.

locale.c

index 30d0ec8..f9a12b5 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -3351,8 +3351,8 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
             /* Standard UTF-8 needs at least 4 bytes to represent the maximum
              * Unicode code point. */
 
-            DEBUG_L(PerlIO_printf(Perl_debug_log, "\tMB_CUR_MAX=%d\n",
-                                       (int) MB_CUR_MAX));
+            DEBUG_L(PerlIO_printf(Perl_debug_log, "%s: %d: MB_CUR_MAX=%d\n",
+                                       __FILE__, __LINE__, (int) MB_CUR_MAX));
             if ((unsigned) MB_CUR_MAX < STRLENs(MAX_UNICODE_UTF8)) {
                 is_utf8 = FALSE;
                 restore_switched_locale(LC_CTYPE, original_ctype_locale);
@@ -3756,7 +3756,54 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 
 #  ifdef DEBUGGING
 
+    if (DEBUG_Lv_TEST) {
+        const char * s = PL_locale_utf8ness;
+
+        /* Audit the structure */
+        while (s < PL_locale_utf8ness + strlen(PL_locale_utf8ness)) {
+            const char *e;
+
+            if (*s != UTF8NESS_SEP[0]) {
+                Perl_croak(aTHX_
+                           "panic: %s: %d: Corrupt utf8ness_cache: missing"
+                           " separator %.*s<-- HERE %s\n",
+                           __FILE__, __LINE__,
+                           s - PL_locale_utf8ness, PL_locale_utf8ness,
+                           s);
+            }
+            s++;
+            e = strchr(s, UTF8NESS_PREFIX[0]);
+            if (! e) {
+                Perl_croak(aTHX_
+                           "panic: %s: %d: Corrupt utf8ness_cache: missing"
+                           " separator %.*s<-- HERE %s\n",
+                           __FILE__, __LINE__,
+                           e - PL_locale_utf8ness, PL_locale_utf8ness,
+                           e);
+            }
+            e++;
+            if (*e != '0' && *e != '1') {
+                Perl_croak(aTHX_
+                           "panic: %s: %d: Corrupt utf8ness_cache: utf8ness"
+                           " must be [01] %.*s<-- HERE %s\n",
+                           __FILE__, __LINE__,
+                           e + 1 - PL_locale_utf8ness, PL_locale_utf8ness,
+                           e + 1);
+            }
+            if (ninstr(PL_locale_utf8ness, s, s-1, e)) {
+                Perl_croak(aTHX_
+                           "panic: %s: %d: Corrupt utf8ness_cache: entry"
+                           " has duplicate %.*s<-- HERE %s\n",
+                           __FILE__, __LINE__,
+                           e - PL_locale_utf8ness, PL_locale_utf8ness,
+                           e);
+            }
+            s = e + 1;
+        }
+    }
+
     if (DEBUG_Lv_TEST || debug_initialization) {
+
         PerlIO_printf(Perl_debug_log,
                 "PL_locale_utf8ness is now %s; returning %d\n",
                                      PL_locale_utf8ness, is_utf8);