B/Deparse.pm: Rework deparsing of UTF-8 tr///

[perl5.git] / lib / locale_threads.t

use strict;
use warnings;

# This file tests interactions with locale and threads

BEGIN {
    chdir 't' if -d 't';
    require './test.pl';
    set_up_inc('../lib');
    require './loc_tools.pl';
    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;

    local $ENV{LC_MESSAGES} = $locales[0];

    # We're going to try with all possible error numbers on this platform
    my $error_count = keys(%!) + 1;

    print fresh_perl("
        use threads;
        use strict;
        use warnings;

        my \$errnum = 1;

        my \@threads = map +threads->create(sub {
            sleep 0.1;

            for (1..5_000) {
                \$errnum = (\$errnum + 1) % $error_count;
                \$! = \$errnum;

                # no-op to trigger stringification
                next if \"\$!\" eq \"\";
            }
        }), (0..1);
        \$_->join for splice \@threads;",
    {}
    );

    pass("Didn't segfault");
}

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();