Add testing global locale switching; Todo #20565

API switch_to_global_locale() and sync_locale() weren't tested because I
hadn't figured out a way to do so, but @dk showed me the way in his
reproducing case for GH #20565.

2 files changed, 60 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index b319c7f494..585d6b38de 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -7837,3 +7837,27 @@ test_CvREFCOUNTED_ANYSV()
     }
     OUTPUT:
         RETVAL
+
+MODULE = XS::APItest            PACKAGE = XS::APItest::global_locale
+
+char *
+switch_to_global_and_setlocale(int category, const char * locale)
+    CODE:
+        switch_to_global_locale();
+        RETVAL = setlocale(category, locale);
+    OUTPUT:
+        RETVAL
+
+bool
+sync_locale()
+    CODE:
+        RETVAL = sync_locale();
+    OUTPUT:
+        RETVAL
+
+NV
+newSvNV(const char * string)
+    CODE:
+        RETVAL = SvNV(newSVpv(string, 0));
+    OUTPUT:
+        RETVAL
diff --git a/ext/XS-APItest/t/locale.t b/ext/XS-APItest/t/locale.t
index 631c522580..19efa9546b 100644
--- a/ext/XS-APItest/t/locale.t
+++ b/ext/XS-APItest/t/locale.t
@@ -34,6 +34,42 @@ SKIP: {
       is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying locale inside 'use locale'");
 }
 
+sub check_in_bounds($$$) {
+    my ($value, $lower, $upper) = @_;
+
+    $value >= $lower && $value <= $upper
+}
+
+SKIP: {
+    # This checks that when switching to the global locale, the service that
+    # Perl provides of transparently dealing with locales that have a non-dot
+    # radix is turned off, but gets turned on again after a sync_locale();
+
+    skip "no locale with a comma radix available", 5 unless $comma_locale;
+
+    my $global_locale = switch_to_global_and_setlocale(LC_NUMERIC,
+                                                       $comma_locale);
+    # Can't do a compare of $global_locale and $comma_locale because what the
+    # system returns may be an alias.  ALl we can do is test for
+    # success/failure
+    ok($global_locale, "Successfully switched to $comma_locale");
+    is(newSvNV("4.888"), 4, "dot not recognized in global comma locale for SvNV");
+
+    no warnings 'numeric';  # Otherwise get "Argument isn't numeric in
+                            # subroutine entry"
+
+    is(check_in_bounds(newSvNV("4,888"), 4.88, 4.89), 1,
+       "comma recognized in global comma locale for SvNV");
+    isnt(sync_locale, 0, "sync_locale() returns that was in the global locale");
+
+    TODO: {
+        local $TODO = "GH #20565";
+
+        is(check_in_bounds(newSvNV("4.888"), 4.88, 4.89), 1,
+        "dot recognized in perl-controlled comma locale for SvNV");
+    }
+}
+
 my %correct_C_responses = (
         # Entries that are undef could have varying returns
                             ABDAY_1 => 'Sun',