In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/9961787152c9adc1b9a2c8b521c7eddc817f7da7?hp=eb76558003b95f2e17e40b58e97e2c66236a259f>
- Log ----------------------------------------------------------------- commit 9961787152c9adc1b9a2c8b521c7eddc817f7da7 Author: Karl Williamson <[email protected]> Date: Mon Mar 19 09:11:24 2018 -0600 t/loc_tools.pl: Special case openbsd The openbsd setlocale() doesn't behave at all like what one would expect from that function. The comments added in this commit give some details. commit 385130ebff29a4096220b4d590f14228d554bd27 Author: Karl Williamson <[email protected]> Date: Tue Apr 17 12:06:53 2018 -0600 t/run/locale.t: Refactor to use done_testing() Various platforms have different locale abilities. It was getting complicated to make sure the skip counts are valid for each combination. commit 40f10af4f46622a2b8196e87bdc0a9f3c175b225 Author: Karl Williamson <[email protected]> Date: Wed Feb 14 21:25:41 2018 -0700 t/run/locale.t: Add debugging code This has proved useful at times ----------------------------------------------------------------------- Summary of changes: t/loc_tools.pl | 19 +- t/run/locale.t | 637 +++++++++++++++++++++++++++++---------------------------- 2 files changed, 341 insertions(+), 315 deletions(-) diff --git a/t/loc_tools.pl b/t/loc_tools.pl index e4a54ea97e..7afb7bacf6 100644 --- a/t/loc_tools.pl +++ b/t/loc_tools.pl @@ -10,6 +10,7 @@ # Functions whose names begin with underscore are internal helper functions # for this file, and are not to be used by outside callers. +use Config; use strict; eval { require POSIX; import POSIX 'locale_h'; }; @@ -108,6 +109,22 @@ sub _trylocale ($$$$) { # For use only by other functions in this file! # systems return if $locale =~ / ^ pig $ /ix; + # As of 6.3, this platform's locale handling is basically broken. khw + # filed a bug report (no ticket number was returned), and it is supposedly + # going to change in a future release, so the statements here below sunset + # for any larger version, at which point this may start failing and have + # to be revisited. + # + # Given a legal individual category, basically whatever you set the locale + # to, the return from setlocale() indicates that it has taken effect, even + # if it hasn't. However, the return from querying LC_ALL won't reflect + # this. + if ($Config{osname} =~ /openbsd/i && $locale !~ / ^ (?: C | POSIX ) $/ix) { + my ($major, $minor) = $Config{osvers} =~ / ^ ( \d+ ) \. ( \d+ ) /ax; + return if ! defined $major || ! defined $minor + || $major < 6 || ($major == 6 && $minor <= 3); + } + $categories = [ $categories ] unless ref $categories; my $badutf8 = 0; @@ -197,8 +214,6 @@ sub locales_enabled(;$) { # denoting a single category (either name or number). No conversion into # a number is done in this case. - use Config; - return 0 unless $Config{d_setlocale} # I (khw) cargo-culted the '?' in the pattern on the # next line. diff --git a/t/run/locale.t b/t/run/locale.t index 9efac0b549..bae51585d1 100644 --- a/t/run/locale.t +++ b/t/run/locale.t @@ -24,10 +24,46 @@ my $have_strtod = $Config{d_strtod} eq 'define'; my @locales = find_locales( [ 'LC_ALL', 'LC_CTYPE', 'LC_NUMERIC' ]); skip_all("no locales available") unless @locales; +my $debug = 0; +my $switches = ""; +if (defined $ARGV[0] && $ARGV[0] ne "") { + if ($ARGV[0] ne 'debug') { + print STDERR "Usage: $0 [ debug ]\n"; + exit 1 + } + $debug = 1; + $switches = "switches => [ '-DLv' ]"; +} + # reset the locale environment delete local @ENV{'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)}; -plan tests => &last; +# If user wants this to happen, they set the environment variable AND use +# 'debug' +delete local $ENV{'PERL_DEBUG_LOCALE_INIT'} unless $debug; + +{ + fresh_perl_is(<<"EOF", + use locale; + use POSIX; + POSIX::setlocale(POSIX::LC_CTYPE(),"C"); + print "h" =~ /[g\\w]/i || 0; + print "\\n"; +EOF + 1, { stderr => 'devnull' }, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char"); +} + +{ + fresh_perl_is(<<"EOF", + use locale; + use POSIX; + POSIX::setlocale(POSIX::LC_CTYPE(),"C"); + print "0" =~ /[\\d[:punct:]]/l || 0; + print "\\n"; +EOF + 1, { stderr => 'devnull' }, "/l matching of [bracketed] doesn't skip non-first POSIX class"); + +} my $non_C_locale; foreach my $locale (@locales) { @@ -36,297 +72,270 @@ foreach my $locale (@locales) { last; } -SKIP: { - skip("no non-C locale available", 2 ) unless $non_C_locale; +if ($non_C_locale) { setlocale(LC_NUMERIC, $non_C_locale); isnt(setlocale(LC_NUMERIC), "C", "retrieving current non-C LC_NUMERIC doesn't give 'C'"); setlocale(LC_ALL, $non_C_locale); isnt(setlocale(LC_ALL), "C", "retrieving current non-C LC_ALL doesn't give 'C'"); -} -# Skip this locale on these cywgwin versions as the returned radix character -# length is wrong -my @test_numeric_locales = ($^O ne 'cygwin' || version->new(($Config{'osvers'} =~ /^(\d+(?:\.\d+)+)/)[0]) gt v2.4.1) - ? @locales - : grep { $_ !~ m/ps_AF/i } @locales; + my @test_numeric_locales = @locales; -fresh_perl_is("for (qw(@test_numeric_locales)) {\n" . <<'EOF', - use POSIX qw(locale_h); - use locale; - setlocale(LC_NUMERIC, "$_") or next; - my $s = sprintf "%g %g", 3.1, 3.1; - next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/; - print "$_ $s\n"; -} -EOF - "", {}, "no locales where LC_NUMERIC breaks"); + # Skip this locale on these cywgwin versions as the returned radix character + # length is wrong + if ( $^O eq 'cygwin' + && version->new(($Config{'osvers'} =~ /^(\d+(?:\.\d+)+)/)[0]) le v2.4.1) + { + @test_numeric_locales = grep { $_ !~ m/ps_AF/i } @test_numeric_locales; + } -SKIP: { - skip("Windows stores locale defaults in the registry", 1 ) - if $^O eq 'MSWin32'; - fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF', + fresh_perl_is("for (qw(@test_numeric_locales)) {\n" . <<'EOF', use POSIX qw(locale_h); use locale; - my $in = 4.2; - my $s = sprintf "%g", $in; # avoid any constant folding bugs - next if $s eq "4.2"; + setlocale(LC_NUMERIC, "$_") or next; + my $s = sprintf "%g %g", 3.1, 3.1; + next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/; print "$_ $s\n"; } EOF - "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale"); -} + "", { eval $switches }, "no locales where LC_NUMERIC breaks"); -# try to find out a locale where LC_NUMERIC makes a difference -my $original_locale = setlocale(LC_NUMERIC); - -my ($base, $different, $comma, $difference, $utf8_radix); -my $radix_encoded_as_utf8; -for ("C", @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") { - $base ||= $_; - } else { - $different ||= $_; - $difference ||= $s; - my $radix = localeconv()->{decimal_point}; - - # For utf8 locales with a non-ascii radix, it should be encoded as - # UTF-8 with the internal flag so set. - if (! defined $utf8_radix - && $radix =~ /[[:^ascii:]]/ - && is_locale_utf8($_)) - { - $utf8_radix = $_; - $radix_encoded_as_utf8 = utf8::is_utf8($radix); - } - else { - $comma ||= $_ if $radix eq ','; + SKIP: { + skip("Windows stores locale defaults in the registry", 1 ) + if $^O eq 'MSWin32'; + fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF', + use POSIX qw(locale_h); + use locale; + my $in = 4.2; + my $s = sprintf "%g", $in; # avoid any constant folding bugs + next if $s eq "4.2"; + print "$_ $s\n"; } +EOF + "", { eval $switches }, "LC_NUMERIC without environment nor setlocale() has no effect in any locale"); } - last if $base && $different && $comma && $utf8_radix; -} -setlocale(LC_NUMERIC, $original_locale); + # try to find out a locale where LC_NUMERIC makes a difference + my $original_locale = setlocale(LC_NUMERIC); -SKIP: { - skip("no UTF-8 locale available where LC_NUMERIC radix isn't ASCII", 1 ) - unless $utf8_radix; - ok($radix_encoded_as_utf8 == 1, "UTF-8 locale '$utf8_radix' with non-ASCII" - . " radix is marked UTF-8"); -} + my ($base, $different, $comma, $difference, $utf8_radix); + my $radix_encoded_as_utf8; + for ("C", @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") { + $base ||= $_; + } else { + $different ||= $_; + $difference ||= $s; + my $radix = localeconv()->{decimal_point}; + + # For utf8 locales with a non-ascii radix, it should be encoded as + # UTF-8 with the internal flag so set. + if (! defined $utf8_radix + && $radix =~ /[[:^ascii:]]/ + && is_locale_utf8($_)) + { + $utf8_radix = $_; + $radix_encoded_as_utf8 = utf8::is_utf8($radix); + } + else { + $comma ||= $_ if $radix eq ','; + } + } -SKIP: { - skip("no locale available where LC_NUMERIC makes a difference", &last - 9 ) - if !$different; # -7 is 5 tests before this block; 2 after - note("using the '$different' locale for LC_NUMERIC tests"); - { - local $ENV{LC_NUMERIC} = $different; + last if $base && $different && $comma && $utf8_radix; + } + setlocale(LC_NUMERIC, $original_locale); - fresh_perl_is(<<'EOF', "4.2", {}, -format STDOUT = + SKIP: { + skip("no UTF-8 locale available where LC_NUMERIC radix isn't ASCII", 1 ) + unless $utf8_radix; + ok($radix_encoded_as_utf8 == 1, "UTF-8 locale '$utf8_radix' with non-ASCII" + . " radix is marked UTF-8"); + } + + if ($different) { + note("using the '$different' locale for LC_NUMERIC tests"); + { + local $ENV{LC_NUMERIC} = $different; + + fresh_perl_is(<<'EOF', "4.2", { eval $switches }, + format STDOUT = @.# 4.179 . -write; + write; EOF - "format() does not look at LC_NUMERIC without 'use locale'"); + "format() does not look at LC_NUMERIC without 'use locale'"); - { - fresh_perl_is(<<'EOF', "$difference\n", {}, -use POSIX; -use locale; -format STDOUT = + { + fresh_perl_is(<<'EOF', "$difference\n", { eval $switches }, + use POSIX; + use locale; + format STDOUT = @.# 4.179 . -write; + write; EOF - "format() looks at LC_NUMERIC with 'use locale'"); - } + "format() looks at LC_NUMERIC with 'use locale'"); + } - { - fresh_perl_is(<<'EOF', ",,", {}, -use POSIX; -print localeconv()->{decimal_point}; -use locale; -print localeconv()->{decimal_point}; + { + fresh_perl_is(<<'EOF', ",,", { eval $switches }, + use POSIX; + print localeconv()->{decimal_point}; + use locale; + print localeconv()->{decimal_point}; EOF - "localeconv() looks at LC_NUMERIC with and without 'use locale'"); - } + "localeconv() looks at LC_NUMERIC with and without 'use locale'"); + } - { - my $categories = ":collate :characters :collate :ctype :monetary :time"; - fresh_perl_is(<<"EOF", "4.2", {}, -use locale qw($categories); -format STDOUT = + { + my $categories = ":collate :characters :collate :ctype :monetary :time"; + fresh_perl_is(<<"EOF", "4.2", { eval $switches }, + use locale qw($categories); + format STDOUT = @.# 4.179 . -write; + write; EOF - "format() does not look at LC_NUMERIC with 'use locale qw($categories)'"); - } + "format() does not look at LC_NUMERIC with 'use locale qw($categories)'"); + } - { - fresh_perl_is(<<'EOF', $difference, {}, -use locale; -format STDOUT = + { + fresh_perl_is(<<'EOF', $difference, { eval $switches }, + use locale; + format STDOUT = @.# 4.179 . -write; + write; EOF - "format() looks at LC_NUMERIC with 'use locale'"); - } + "format() looks at LC_NUMERIC with 'use locale'"); + } - for my $category (qw(collate characters collate ctype monetary time)) { - for my $negation ("!", "not_") { - fresh_perl_is(<<"EOF", $difference, {}, -use locale ":$negation$category"; + for my $category (qw(collate characters collate ctype monetary time)) { + for my $negation ("!", "not_") { + fresh_perl_is(<<"EOF", $difference, { eval $switches }, + use locale ":$negation$category"; format STDOUT = @.# 4.179 . -write; + write; EOF - "format() looks at LC_NUMERIC with 'use locale \":" - . "$negation$category\"'"); + "format() looks at LC_NUMERIC with 'use locale \":" + . "$negation$category\"'"); + } } - } - { - fresh_perl_is(<<'EOF', $difference, {}, -use locale ":numeric"; + { + fresh_perl_is(<<'EOF', $difference, { eval $switches }, + use locale ":numeric"; format STDOUT = @.# 4.179 . -write; + write; EOF - "format() looks at LC_NUMERIC with 'use locale \":numeric\"'"); - } + "format() looks at LC_NUMERIC with 'use locale \":numeric\"'"); + } - { - fresh_perl_is(<<'EOF', "4.2", {}, + { + fresh_perl_is(<<'EOF', "4.2", { eval $switches }, format STDOUT = @.# 4.179 . -{ use locale; write; } + { use locale; write; } EOF - "too late to look at the locale at write() time"); - } + "too late to look at the locale at write() time"); + } - { - fresh_perl_is(<<'EOF', $difference, {}, -use locale; -format STDOUT = + { + fresh_perl_is(<<'EOF', $difference, { eval $switches }, + use locale; + format STDOUT = @.# 4.179 . -{ no locale; write; } + { no locale; write; } EOF - "too late to ignore the locale at write() time"); + "too late to ignore the locale at write() time"); + } } - } - { - # do not let "use 5.000" affect the locale! - # this test is to prevent regression of [rt.perl.org #105784] - fresh_perl_is(<<"EOF", - use locale; - use POSIX; - my \$i = 0.123; - POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); - \$a = sprintf("%.2f", \$i); - require version; - \$b = sprintf("%.2f", \$i); - print ".\$a \$b" unless \$a eq \$b -EOF - "", {}, "version does not clobber version"); - - fresh_perl_is(<<"EOF", - use locale; - use POSIX; - my \$i = 0.123; - POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); - \$a = sprintf("%.2f", \$i); - eval "use v5.0.0"; - \$b = sprintf("%.2f", \$i); - print "\$a \$b" unless \$a eq \$b + { + # do not let "use 5.000" affect the locale! + # this test is to prevent regression of [rt.perl.org #105784] + fresh_perl_is(<<"EOF", + use locale; + use POSIX; + my \$i = 0.123; + POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); + \$a = sprintf("%.2f", \$i); + require version; + \$b = sprintf("%.2f", \$i); + print ".\$a \$b" unless \$a eq \$b EOF - "", {}, "version does not clobber version (via eval)"); - } + "", { eval $switches }, "version does not clobber version"); - { - local $ENV{LC_NUMERIC} = $different; - fresh_perl_is(<<'EOF', "$difference "x4, {}, - use locale; - use POSIX qw(locale_h); - my $in = 4.2; - printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2)); + fresh_perl_is(<<"EOF", + use locale; + use POSIX; + my \$i = 0.123; + POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); + \$a = sprintf("%.2f", \$i); + eval "use v5.0.0"; + \$b = sprintf("%.2f", \$i); + print "\$a \$b" unless \$a eq \$b EOF - "sprintf() and printf() look at LC_NUMERIC regardless of constant folding"); - } + "", { eval $switches }, "version does not clobber version (via eval)"); + } - { - local $ENV{LC_NUMERIC} = $different; - fresh_perl_is(<<'EOF', "$difference "x4, {}, - use locale; - use POSIX qw(locale_h); - my $in = 4.2; - printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2)); + { + local $ENV{LC_NUMERIC} = $different; + fresh_perl_is(<<'EOF', "$difference "x4, { eval $switches }, + use locale; + use POSIX qw(locale_h); + my $in = 4.2; + printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2)); EOF - "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC"); - } - - - # within this block, STDERR is closed. This is because fresh_perl_is() - # forks a shell, and some shells (like bash) can complain noisily when - # LC_ALL or similar is set to an invalid value - - { - open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!"; - close STDERR; + "sprintf() and printf() look at LC_NUMERIC regardless of constant folding"); + } { - local $ENV{LC_ALL} = "invalid"; - local $ENV{LC_NUMERIC} = "invalid"; - local $ENV{LANG} = $different; - local $ENV{PERL_BADLANG} = 0; - - if (! fresh_perl_is(<<"EOF", "$difference", { }, - if (\$ENV{LC_ALL} ne "invalid") { - # Make the test pass if the sh didn't accept the ENV set - print "$difference\n"; - exit 0; - } + local $ENV{LC_NUMERIC} = $different; + fresh_perl_is(<<'EOF', "$difference "x4, { eval $switches }, use locale; use POSIX qw(locale_h); - my \$in = 4.2; - printf("%g", \$in); + my $in = 4.2; + printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2)); EOF - "LANG is used if LC_ALL, LC_NUMERIC are invalid")) - { - note "To see details change this .t, do not close STDERR"; - } + "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC"); } - SKIP: { - if ($^O eq 'MSWin32') { - skip("Win32 uses system default locale in preference to \"C\"", - 1); - } - else { + + # within this block, STDERR is closed. This is because fresh_perl_is() + # forks a shell, and some shells (like bash) can complain noisily when + # LC_ALL or similar is set to an invalid value + + { + open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!"; + close STDERR; + + { local $ENV{LC_ALL} = "invalid"; local $ENV{LC_NUMERIC} = "invalid"; - local $ENV{LANG} = "invalid"; + local $ENV{LANG} = $different; local $ENV{PERL_BADLANG} = 0; - if (! fresh_perl_is(<<"EOF", 4.2, { }, + if (! fresh_perl_is(<<"EOF", "$difference", { eval $switches }, if (\$ENV{LC_ALL} ne "invalid") { + # Make the test pass if the sh didn't accept the ENV set print "$difference\n"; exit 0; } @@ -335,138 +344,140 @@ EOF my \$in = 4.2; printf("%g", \$in); EOF - 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid')) - { - note "To see details change this .t, do not close STDERR"; - } + "LANG is used if LC_ALL, LC_NUMERIC are invalid")) + { + note "To see details change this .t, do not close STDERR"; + } } - } - - open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!"; - } - { - local $ENV{LC_NUMERIC} = $different; - fresh_perl_is(<<"EOF", - use POSIX qw(locale_h); - - BEGIN { setlocale(LC_NUMERIC, \"$different\"); }; - setlocale(LC_ALL, "C"); - use 5.008; - print setlocale(LC_NUMERIC); + SKIP: { + if ($^O eq 'MSWin32') { + skip("Win32 uses system default locale in preference to \"C\"", + 1); + } + else { + local $ENV{LC_ALL} = "invalid"; + local $ENV{LC_NUMERIC} = "invalid"; + local $ENV{LANG} = "invalid"; + local $ENV{PERL_BADLANG} = 0; + + if (! fresh_perl_is(<<"EOF", 4.2, { eval $switches }, + if (\$ENV{LC_ALL} ne "invalid") { + print "$difference\n"; + exit 0; + } + use locale; + use POSIX qw(locale_h); + my \$in = 4.2; + printf("%g", \$in); EOF - "C", { stderr => 'devnull' }, - "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix"); - } + 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid')) + { + note "To see details change this .t, do not close STDERR"; + } + } + } - unless ($comma) { - skip("no locale available where LC_NUMERIC is a comma", 3); - } - else { + open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!"; + } - fresh_perl_is(<<"EOF", - my \$i = 1.5; - { - use locale; - use POSIX; - POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); - print \$i, "\n"; - } - print \$i, "\n"; -EOF - "1,5\n1.5", { stderr => 'devnull' }, "Radix print properly in locale scope, and without"); + { + local $ENV{LC_NUMERIC} = $different; + fresh_perl_is(<<"EOF", + use POSIX qw(locale_h); - fresh_perl_is(<<"EOF", - my \$i = 1.5; # Should be exactly representable as a base 2 - # fraction, so can use 'eq' below - use locale; - use POSIX; - POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); - print \$i, "\n"; - \$i += 1; - print \$i, "\n"; + BEGIN { setlocale(LC_NUMERIC, \"$different\"); }; + setlocale(LC_ALL, "C"); + use 5.008; + print setlocale(LC_NUMERIC); EOF - "1,5\n2,5", { stderr => 'devnull' }, "Can do math when radix is a comma"); # [perl 115800] + "C", { stderr => 'devnull' }, + "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix"); + } - unless ($have_strtod) { - skip("no strtod()", 1); + unless ($comma) { + skip("no locale available where LC_NUMERIC is a comma", 3); } else { + fresh_perl_is(<<"EOF", - use POSIX; - POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); - my \$one_point_5 = POSIX::strtod("1,5"); - \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros - print \$one_point_5, "\n"; + my \$i = 1.5; + { + use locale; + use POSIX; + POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); + print \$i, "\n"; + } + print \$i, "\n"; EOF - "1.5", { stderr => 'devnull' }, "POSIX::strtod() uses underlying locale"); - } - } -} # SKIP + "1,5\n1.5", { stderr => 'devnull' }, "Radix print properly in locale scope, and without"); - { - fresh_perl_is(<<"EOF", + fresh_perl_is(<<"EOF", + my \$i = 1.5; # Should be exactly representable as a base 2 + # fraction, so can use 'eq' below use locale; use POSIX; - POSIX::setlocale(POSIX::LC_CTYPE(),"C"); - print "h" =~ /[g\\w]/i || 0; - print "\\n"; + POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); + print \$i, "\n"; + \$i += 1; + print \$i, "\n"; EOF - 1, { stderr => 'devnull' }, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char"); - } + "1,5\n2,5", { stderr => 'devnull' }, "Can do math when radix is a comma"); # [perl 115800] - { - fresh_perl_is(<<"EOF", - use locale; - use POSIX; - POSIX::setlocale(POSIX::LC_CTYPE(),"C"); - print "0" =~ /[\\d[:punct:]]/l || 0; - print "\\n"; + unless ($have_strtod) { + skip("no strtod()", 1); + } + else { + fresh_perl_is(<<"EOF", + use POSIX; + POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); + my \$one_point_5 = POSIX::strtod("1,5"); + \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros + print \$one_point_5, "\n"; EOF - 1, { stderr => 'devnull' }, "/l matching of [bracketed] doesn't skip non-first POSIX class"); - + "1.5", { stderr => 'devnull' }, "POSIX::strtod() uses underlying locale"); + } + } } -SKIP: { - - my @valid_categories = valid_locale_categories(); + { + my @valid_categories = valid_locale_categories(); - my $valid_string = ""; - my $invalid_string = ""; + my $valid_string = ""; + my $invalid_string = ""; - # Deliberately don't include all categories, so as to test this situation - for my $i (0 .. @valid_categories - 2) { - my $category = $valid_categories[$i]; - if ($category ne "LC_ALL") { - $invalid_string .= ";" if $invalid_string ne ""; - $invalid_string .= "$category=foo_BAR"; + # Deliberately don't include all categories, so as to test this situation + for my $i (0 .. @valid_categories - 2) { + my $category = $valid_categories[$i]; + if ($category ne "LC_ALL") { + $invalid_string .= ";" if $invalid_string ne ""; + $invalid_string .= "$category=foo_BAR"; - next unless $non_C_locale; - $valid_string .= ";" if $valid_string ne ""; - $valid_string .= "$category=$non_C_locale"; + next unless $non_C_locale; + $valid_string .= ";" if $valid_string ne ""; + $valid_string .= "$category=$non_C_locale"; + } } - } - fresh_perl(<<"EOF", - use locale; - use POSIX; - POSIX::setlocale(LC_ALL, "$invalid_string"); + fresh_perl(<<"EOF", + use locale; + use POSIX; + POSIX::setlocale(LC_ALL, "$invalid_string"); EOF - {}); - is ($?, 0, "In setting complicated invalid LC_ALL, final individ category doesn't need a \';'"); + {}); + is ($?, 0, "In setting complicated invalid LC_ALL, final individ category doesn't need a \';'"); - skip("no non-C locale available", 1 ) unless $non_C_locale; - fresh_perl(<<"EOF", - use locale; - use POSIX; - POSIX::setlocale(LC_ALL, "$valid_string"); + skip("no non-C locale available", 1 ) unless $non_C_locale; + fresh_perl(<<"EOF", + use locale; + use POSIX; + POSIX::setlocale(LC_ALL, "$valid_string"); EOF - {}); - is ($?, 0, "In setting complicated valid LC_ALL, final individ category doesn't need a \';'"); + {}); + is ($?, 0, "In setting complicated valid LC_ALL, final individ category doesn't need a \';'"); + + } } -# IMPORTANT: When adding tests before the following line, be sure to update -# its skip count: -# skip("no locale available where LC_NUMERIC makes a difference", ...) -sub last { 39 } +done_testing(); -- Perl5 Master Repository
