lib/locale_threads.t: Add safe thread test

1 files changed, 70 insertions, 3 deletions

diff --git a/lib/locale_threads.t b/lib/locale_threads.t
index 72d322ee37..cda570be3a 100644
--- a/lib/locale_threads.t
+++ b/lib/locale_threads.t
@@ -11,14 +11,19 @@ BEGIN {
     skip_all("No locales") unless locales_enabled();
     skip_all_without_config('useithreads');
     $| = 1;
+    eval { require POSIX; POSIX->import(qw(locale_h  unistd_h)) };
+    if ($@) {
+	skip_all("could not load the POSIX module"); # running minitest?
+    }
 }
 
+# reset the locale environment
+local @ENV{'LANG', (grep /^LC_/, keys %ENV)};
+
 SKIP: { # perl #127708
     my @locales = grep { $_ !~ / ^ C \b | POSIX /x } find_locales('LC_MESSAGES');
     skip("No valid locale to test with", 1) unless @locales;
 
-    # reset the locale environment
-    local @ENV{'LANG', (grep /^LC_/, keys %ENV)};
     local $ENV{LC_MESSAGES} = $locales[0];
 
     # We're going to try with all possible error numbers on this platform
@@ -49,4 +54,66 @@ SKIP: { # perl #127708
     pass("Didn't segfault");
 }
 
-done_testing;
+SKIP: {
+    skip("POSIX version doesn't support thread-safe locale operations", 1)
+                                                unless ${^SAFE_LOCALES};
+
+    my @locales = find_locales( 'LC_NUMERIC' );
+    skip("No LC_NUMERIC locales available", 1) unless @locales;
+
+    my $dot = "";
+    my $comma = "";
+    for (@locales) { # prefer C for the base if available
+        use locale;
+        setlocale(LC_NUMERIC, $_) or next;
+        my $in = 4.2; # avoid any constant folding bugs
+        if ((my $s = sprintf("%g", $in)) eq "4.2")  {
+            $dot ||= $_;
+        } else {
+            my $radix = localeconv()->{decimal_point};
+            $comma ||= $_ if $radix eq ',';
+        }
+
+        last if $dot && $comma;
+    }
+
+    # See if multiple threads can simultaneously change the locale, and give
+    # the expected radix results.  On systems without a comma radix locale,
+    # run this anyway skipping the use of that, to verify that we don't
+    # segfault
+    fresh_perl_is("
+        use threads;
+        use strict;
+        use warnings;
+        use POSIX qw(locale_h);
+
+        my \$result = 1;
+
+        my \@threads = map +threads->create(sub {
+            sleep 0.1;
+            for (1..5_000) {
+                my \$s;
+                my \$in = 4.2; # avoid any constant folding bugs
+
+                if ('$comma') {
+                    setlocale(&LC_NUMERIC, '$comma');
+                    use locale;
+                    \$s = sprintf('%g', \$in);
+                    return 0 if (\$s ne '4,2');
+                }
+
+                setlocale(&LC_NUMERIC, '$dot');
+                \$s = sprintf('%g', \$in);
+                return 0 if (\$s ne '4.2');
+            }
+
+            return 1;
+
+        }), (0..3);
+        \$result &= \$_->join for splice \@threads;
+        print \$result",
+    1, {}, "Verify there were no failures with simultaneous running threads"
+    );
+}
+
+done_testing();