xref: /openbsd/gnu/usr.bin/perl/lib/locale_threads.t (revision 5dea098c) 
1use strict;
2use warnings;
3
4# This file tests interactions with locale and threads
5
6BEGIN {
7    chdir 't' if -d 't';
8    require './test.pl';
9    set_up_inc('../lib');
10    require './loc_tools.pl';
11    skip_all("No locales") unless locales_enabled();
12    skip_all_without_config('useithreads');
13    $| = 1;
14    eval { require POSIX; POSIX->import(qw(locale_h  unistd_h)) };
15    if ($@) {
16	skip_all("could not load the POSIX module"); # running minitest?
17    }
18}
19
20# reset the locale environment
21local @ENV{'LANG', (grep /^LC_/, keys %ENV)};
22
23SKIP: { # perl #127708
24    my @locales = grep { $_ !~ / ^ C \b | POSIX /x } find_locales('LC_MESSAGES');
25    skip("No valid locale to test with", 1) unless @locales;
26
27    local $ENV{LC_MESSAGES} = $locales[0];
28
29    # We're going to try with all possible error numbers on this platform
30    my $error_count = keys(%!) + 1;
31
32    print fresh_perl("
33        use threads;
34        use strict;
35        use warnings;
36
37        my \$errnum = 1;
38
39        my \@threads = map +threads->create(sub {
40            sleep 0.1;
41
42            for (1..5_000) {
43                \$errnum = (\$errnum + 1) % $error_count;
44                \$! = \$errnum;
45
46                # no-op to trigger stringification
47                next if \"\$!\" eq \"\";
48            }
49        }), (0..1);
50        \$_->join for splice \@threads;",
51    {}
52    );
53
54    pass("Didn't segfault");
55}
56
57SKIP: {
58    skip("POSIX version doesn't support thread-safe locale operations", 1)
59                                                unless ${^SAFE_LOCALES};
60
61    my @locales = find_locales( 'LC_NUMERIC' );
62    skip("No LC_NUMERIC locales available", 1) unless @locales;
63
64    my $dot = "";
65    my $comma = "";
66    for (@locales) { # prefer C for the base if available
67        use locale;
68        setlocale(LC_NUMERIC, $_) or next;
69        my $in = 4.2; # avoid any constant folding bugs
70        if ((my $s = sprintf("%g", $in)) eq "4.2")  {
71            $dot ||= $_;
72        } else {
73            my $radix = localeconv()->{decimal_point};
74            $comma ||= $_ if $radix eq ',';
75        }
76
77        last if $dot && $comma;
78    }
79
80    # See if multiple threads can simultaneously change the locale, and give
81    # the expected radix results.  On systems without a comma radix locale,
82    # run this anyway skipping the use of that, to verify that we don't
83    # segfault
84    fresh_perl_is("
85        use threads;
86        use strict;
87        use warnings;
88        use POSIX qw(locale_h);
89
90        my \$result = 1;
91
92        my \@threads = map +threads->create(sub {
93            sleep 0.1;
94            for (1..5_000) {
95                my \$s;
96                my \$in = 4.2; # avoid any constant folding bugs
97
98                if ('$comma') {
99                    setlocale(&LC_NUMERIC, '$comma');
100                    use locale;
101                    \$s = sprintf('%g', \$in);
102                    return 0 if (\$s ne '4,2');
103                }
104
105                setlocale(&LC_NUMERIC, '$dot');
106                \$s = sprintf('%g', \$in);
107                return 0 if (\$s ne '4.2');
108            }
109
110            return 1;
111
112        }), (0..3);
113        \$result &= \$_->join for splice \@threads;
114        print \$result",
115    1, {}, "Verify there were no failures with simultaneous running threads"
116    );
117}
118
119done_testing();
120