XXX t/loc_tools.pl: Temp debug

Perl · Jan 31, 2023 · d68ef0a · d68ef0a
1 parent 312a507
commit d68ef0a
Showing 1 changed file with 28 additions and 0 deletions.
diff --git a/t/loc_tools.pl b/t/loc_tools.pl
@@ -191,6 +191,7 @@ ($$$$)
                     /Locale .* may not work well(?#
                    )|The Perl program will use the expected meanings/i
             } @_;
+        print STDERR "#", __FILE__, ": ", __LINE__, ": @_\n" if $debug;
     };
 
     my $first_time = 1;
@@ -209,11 +210,14 @@ ($$$$)
         #local $^D = $d;
 
         my $result = setlocale($category, $locale);
+        print STDERR "#", __FILE__, ": ", __LINE__, ": undef\n"  if $debug && ! defined $result;
         return unless defined $result;
 
         #$^D = $save_D;
         no locale;
 
+        print STDERR "#", __FILE__, ": ", __LINE__, ": $result\n" if $debug;
+
         # We definitely don't want the locale set to something that is
         # unsupported
         die "Couldn't restore locale '$save_locale', category $category"
@@ -246,6 +250,7 @@ ($$$$)
         return unless $plays_well || $allow_incompatible;
     }
 
+    print STDERR '#', __FILE__, ": ", __LINE__, ": Adding $locale to list\n" if $debug;
     push @$list, $locale;
 }
 
@@ -314,6 +319,9 @@ (;$)
     # normally would be available
     return 0 if ! defined &DynaLoader::boot_DynaLoader;
 
+    # Don't test locales where they aren't at all safe.
+    #return 0 if $Config{ccflags} =~ /\bD?NO_THREAD_SAFE_LOCALE_EMULATION\b/;
+
     # Don't test locales where they aren't safe.  On systems with unsafe
     # threads, for the purposes of testing, we consider the main thread safe,
     # and all other threads unsafe.
@@ -438,7 +446,10 @@ ($;$)
     my @categories = (ref $input_categories)
                       ? $input_categories->@*
                       : $input_categories;
+    #use Data::Dumper;
+    #print STDERR __FILE__, ": ", __LINE__, ": ", "finding\n", Dumper \@categories;
     return unless locales_enabled(\@categories);
+    print STDERR __FILE__, ": ", __LINE__, ": ", "enabled, (allow incompat=$allow_incompatible)\n" if $debug;
 
     # Note, the subroutine call above converts the $categories into a form
     # suitable for _trylocale().
@@ -465,6 +476,7 @@ ($;$)
     return sort @Locale if defined $Config{d_setlocale_accepts_any_locale_name};
 
     foreach (1..16) {
+        #print STDERR __FILE__, ": ", __LINE__, ": ", "foreach\n";
         _trylocale("ISO8859-$_", \@categories, \@Locale, $allow_incompatible);
         _trylocale("iso8859$_", \@categories, \@Locale, $allow_incompatible);
         _trylocale("iso8859-$_", \@categories, \@Locale, $allow_incompatible);
@@ -493,9 +505,12 @@ ($;$)
             # locales will cause all IO hadles to default to (assume) utf8
             next unless utf8::valid($_);
             chomp;
+            print STDERR __FILE__, ": ", __LINE__, ": ", "trying $_\n" if $debug;
             _trylocale($_, \@categories, \@Locale, $allow_incompatible);
+            print STDERR __FILE__, ": ", __LINE__, ": ", "Finished trying $_\n" if $debug;
         }
         close(LOCALES);
+            print STDERR __FILE__, ": ", __LINE__, ": ", "done \n" if $debug;
     } elsif ($^O eq 'VMS'
              && defined($ENV{'SYS$I18N_LOCALE'})
              && -d 'SYS$I18N_LOCALE')
@@ -582,6 +597,7 @@ ($;$)
 
     @Locale = sort @Locale;
 
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "returning \n" if $debug;
     return @Locale;
 }
 
@@ -594,11 +610,14 @@ ($)
     return 0 unless locales_enabled('LC_CTYPE');
 
     my $locale = shift;
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "is_locale_utf8: $locale\n" if $debug;
 
     no warnings 'locale'; # We may be trying out a weird locale
     use locale;
 
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "is_locale_utf8: $locale\n" if $debug;
     my $save_locale = setlocale(&POSIX::LC_CTYPE());
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "is_locale_utf8: $locale, saved=$save_locale\n" if $debug;
     if (! $save_locale) {
         _my_fail("Verify could save previous locale");
         return 0;
@@ -621,6 +640,7 @@ ($)
     # most platforms with UTF-8 in its name, so if there is a bug in the op
     # giving a false negative, we should get a failure for those locales as we
     # go through testing all the locales on the platform.
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "is_locale_utf8: $locale\n" if $debug;
     if (CORE::fc(chr utf8::unicode_to_native(0xdf)) ne "ss") {
         if ($locale =~ /UTF-?8/i) {
             _my_fail("Verify $locale with UTF-8 in name is a UTF-8 locale");
@@ -629,6 +649,7 @@ ($)
     else {
         $ret = 1;
     }
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "is_locale_utf8: $locale\n" if $debug;
 
     die "Couldn't restore locale '$save_locale'"
                             unless setlocale(&POSIX::LC_CTYPE(), $save_locale);
@@ -668,8 +689,10 @@ (;$)
     my $locales_ref = shift;
     if (! defined $locales_ref) {
 
+        print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_ctype_locales:\n" if $debug;
         my @locales = find_locales(&POSIX::LC_CTYPE());
         $locales_ref = \@locales;
+        print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_ctype_locales:\n" if $debug;
     }
 
     my ($utf8_ref, undef) = classify_locales_wrt_utf8ness($locales_ref);
@@ -686,6 +709,7 @@ (;$)
                                   # platform
     my $try_locales_ref = shift;
 
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_ctype_locale:\n" if $debug;
     my @utf8_locales = find_utf8_ctype_locales($try_locales_ref);
     my @turkic_locales = find_utf8_turkic_locales($try_locales_ref);
 
@@ -698,6 +722,7 @@ (;$)
         return $locale unless exists $seen_turkic{$locale};
     }
 
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_ctype_locale:\n" if $debug;
     return;
 }
 
@@ -711,7 +736,9 @@ (;$)
 
     return unless locales_enabled('LC_CTYPE');
 
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_turkic_locales:\n" if $debug;
     my $save_locale = setlocale(&POSIX::LC_CTYPE());
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_turkic_locales, saved=$save_locale\n" if $debug;
     foreach my $locale (find_utf8_ctype_locales(shift)) {
         use locale;
         #local $^D = $d;
@@ -722,6 +749,7 @@ (;$)
 
     die "Couldn't restore locale '$save_locale'"
                             unless setlocale(&POSIX::LC_CTYPE(), $save_locale);
+    print STDERR "# ", __FILE__, ": ", __LINE__, ": ", "find_utf8_turkic_locales: save=$save_locale\n" if $debug;
 
     return @return;
 }