Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

version.pm blows away locale #11791

Closed
p5pRT opened this issue Dec 9, 2011 · 14 comments
Closed

version.pm blows away locale #11791

p5pRT opened this issue Dec 9, 2011 · 14 comments

Comments

@p5pRT
Copy link

p5pRT commented Dec 9, 2011

Migrated from rt.perl.org#105784 (status was 'resolved')

Searchable as RT105784$

@p5pRT
Copy link
Author

p5pRT commented Dec 9, 2011

From @rjbs

Created by @rjbs

Loading version.pm seems to blow away locale settings. Here's a program​:

  use strict;
  use locale;
  use POSIX;
  my $i = 0.123;
  POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE");
  printf("%.2f\n", $i);
  require version;
  printf("%.2f\n", $i);

This is worse than it seems. This came up when version was loaded by "use
5.005" in constant.pm -- so loading anything at runtime that has a "use
VERSION" check loads version.pm, killing locales.

Perl Info

Flags:
    category=library
    severity=medium
    module=version

Site configuration information for perl 5.14.2:

Configured by rjbs at Tue Nov 15 23:14:56 EST 2011.

Summary of my perl5 (revision 5 version 14 subversion 2) configuration:
   
  Platform:
    osname=darwin, osvers=11.2.0, archname=darwin-2level
    uname='darwin walrus.local 11.2.0 darwin kernel version 11.2.0: tue aug 9 20:54:00 pdt 2011; root:xnu-1699.24.8~1release_x86_64 x86_64 '
    config_args='-de -Dprefix=/Users/rjbs/perl5/perlbrew/perls/14.2 -Dusedtrace'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include',
    optimize='-O3',
    cppflags='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include'
    ccversion='', gccversion='4.2.1 (Based on Apple Inc. build 5658) (LLVM build 2335.15.00)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib -L/opt/local/lib'
    libpth=/usr/local/lib /opt/local/lib /usr/lib
    libs=-lgdbm -ldbm -ldl -lm -lutil -lc
    perllibs=-ldl -lm -lutil -lc
    libc=, so=dylib, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -L/opt/local/lib -fstack-protector'

Locally applied patches:
    


@INC for perl 5.14.2:
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level
    /Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5
    /Users/rjbs/perl5/perlbrew/perls/14.2/lib/site_perl/5.14.2/darwin-2level
    /Users/rjbs/perl5/perlbrew/perls/14.2/lib/site_perl/5.14.2
    /Users/rjbs/perl5/perlbrew/perls/14.2/lib/5.14.2/darwin-2level
    /Users/rjbs/perl5/perlbrew/perls/14.2/lib/5.14.2
    .


Environment for perl 5.14.2:
    DYLD_LIBRARY_PATH (unset)
    HOME=/Users/rjbs
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/Users/rjbs/.perlbrew/libs/14.2@std/bin:/Users/rjbs/perl5/perlbrew/bin:/Users/rjbs/perl5/perlbrew/perls/14.2/bin:/Users/rjbs/bin:/usr/local/bin:/Users/rjbs/.perlbrew/libs/14.2@std/bin:/Users/rjbs/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:/opt/local/bin:/opt/local/bin
    PERL5LIB=/Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level:/Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5:/Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5/darwin-2level:/Users/rjbs/.perlbrew/libs/14.2@std/lib/perl5:
    PERLBREW_BASHRC_VERSION=0.33
    PERLBREW_HOME=/Users/rjbs/.perlbrew
    PERLBREW_LIB=std
    PERLBREW_PATH=/Users/rjbs/.perlbrew/libs/14.2@std/bin:/Users/rjbs/perl5/perlbrew/bin:/Users/rjbs/perl5/perlbrew/perls/14.2/bin
    PERLBREW_PERL=14.2
    PERLBREW_ROOT=/Users/rjbs/perl5/perlbrew
    PERLBREW_VERSION=0.30
    PERL_AUTOINSTALL=--skipdeps
    PERL_BADLANG (unset)
    PERL_LOCAL_LIB_ROOT=/Users/rjbs/.perlbrew/libs/14.2@std
    PERL_MB_OPT=--install_base /Users/rjbs/.perlbrew/libs/14.2@std
    PERL_MM_OPT=INSTALL_BASE=/Users/rjbs/.perlbrew/libs/14.2@std
    SHELL=/opt/local/bin/zsh

@p5pRT
Copy link
Author

p5pRT commented Dec 9, 2011

From @nwc10

On Fri Dec 09 05​:48​:11 2011, rjbs wrote​:

Loading version.pm seems to blow away locale settings. Here's a
program​:

use strict;
use locale;
use POSIX;
my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE");
printf("%.2f\n", $i);
require version;
printf("%.2f\n", $i);

This is worse than it seems. This came up when version was loaded by
"use
5.005" in constant.pm -- so loading anything at runtime that has a
"use
VERSION" check loads version.pm, killing locales.

../perl/Porting/bisect.pl --start
a7ad731 -- ./perl -Ilib -Mlocale
-MPOSIX -e 'my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i);
require version; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b'

[explicit start is the commit that added version.pm, and it's needed
because the buggy behaviour is present in all released versions of perl]

produces

HEAD is now at b5b5a8f A better version of change #28847
bad - non-zero exit from ./perl -Ilib -Mlocale -MPOSIX -e my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i);
require version; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b
b5b5a8f is the first bad commit
commit b5b5a8f
Author​: Rafael Garcia-Suarez <rgarciasuarez@​gmail.com>
Date​: Sun Sep 17 13​:32​:18 2006 +0000

  A better version of change #28847
  p4raw-link​: @​28847 on //depot/perl​:
e24f8a7

  p4raw-id​: //depot/perl@​28861

:100644 100644 7bbcbdbed9b8d2f447bd709966e5fd433bc8e6ab
52395cce691362d5abcdf3390436256c9e4b1018 M universal.c
:100644 100644 6be13df4a900051c9ccf1c044e2a14047cfcb647
dedd81a17da8cadaa3b5b01ab9d61cbf34f30257 M util.c
bisect run success
That took 2009 seconds

$ git show b5b5a8f
commit b5b5a8f
Author​: Rafael Garcia-Suarez <rgarciasuarez@​gmail.com>
Date​: Sun Sep 17 13​:32​:18 2006 +0000

  A better version of change #28847
  p4raw-link​: @​28847 on //depot/perl​:
e24f8a7
 
  p4raw-id​: //depot/perl@​28861

Inline Patch
diff --git a/universal.c b/universal.c
index 7bbcbdb..52395cc 100644
--- a/universal.c
+++ b/universal.c
@@ -688,7 +688,13 @@ XS(XS_version_qv)
 	    if ( SvNOK(ver) ) /* may get too much accuracy */
 	    {
 		char tbuf[64];
+#ifdef USE_LOCALE_NUMERIC
+		char *loc = setlocale(LC_NUMERIC, "C");
+#endif
 		const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf,
SvNVX(ver)); \+\#ifdef USE\_LOCALE\_NUMERIC \+ setlocale\(LC\_NUMERIC\, loc\); \+\#endif   version = savepvn\(tbuf\, len\);   \}   else
Inline Patch
diff --git a/util.c b/util.c
index 6be13df..dedd81a 100644
--- a/util.c
+++ b/util.c
@@ -4304,9 +4304,13 @@ Perl_upg_version(pTHX_ SV *ver)
     {
 	char tbuf[64];
 	STRLEN len;
-	SET_NUMERIC_STANDARD();
+#ifdef USE_LOCALE_NUMERIC
+	char *loc = setlocale(LC_NUMERIC, "C");
+#endif
 	len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
-	SET_NUMERIC_LOCAL();
+#ifdef USE_LOCALE_NUMERIC
+	setlocale(LC_NUMERIC, loc);
+#endif
 	while (tbuf[len-1] == '0' && len > 0) len--;
 	version = savepvn(tbuf, len);
     }


Reading the man page carefully, and a test program, suggests that we're not calling setlocale\(\) correctly\. It doesn't return the previous value\. It always returns the current value\. Hence to \*read\* it one has to use NULL\.

$ cat setlocale.c
#include <locale.h>
#include <stdio.h>

int
main(int argc, char **argv) {
  while (*++argv) {
printf("setlocale(LC_NUMERIC, NULL) returns '%s'\n",
  setlocale(LC_NUMERIC, NULL));
printf("setlocale(LC_NUMERIC, %s) returns '%s'\n",
  *argv, setlocale(LC_NUMERIC, *argv));
  }
  return 0;
}
$ ./setlocale POSIX
setlocale(LC_NUMERIC, NULL) returns 'C'
setlocale(LC_NUMERIC, POSIX) returns 'POSIX'

C patch coming soon, but it would be useful for someone else to write
regression tests.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Dec 9, 2011

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Dec 9, 2011

From @rjbs

On Fri Dec 09 05​:48​:11 2011, rjbs wrote​:

Loading version.pm seems to blow away locale settings. Here's a
program​:

use strict;
use locale;
use POSIX;
my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE");
printf("%.2f\n", $i);
require version;
printf("%.2f\n", $i);

This is worse than it seems. This came up when version was loaded by
"use
5.005" in constant.pm -- so loading anything at runtime that has a
"use
VERSION" check loads version.pm, killing locales.

../perl/Porting/bisect.pl --start
a7ad731 -- ./perl -Ilib -Mlocale
-MPOSIX -e 'my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i);
require version; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b'

[explicit start is the commit that added version.pm, and it's needed
because the buggy behaviour is present in all released versions of perl]

produces

HEAD is now at b5b5a8f A better version of change #28847
bad - non-zero exit from ./perl -Ilib -Mlocale -MPOSIX -e my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i);
require version; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b
b5b5a8f is the first bad commit
commit b5b5a8f
Author​: Rafael Garcia-Suarez <rgarciasuarez@​gmail.com>
Date​: Sun Sep 17 13​:32​:18 2006 +0000

  A better version of change #28847
  p4raw-link​: @​28847 on //depot/perl​:
e24f8a7

  p4raw-id​: //depot/perl@​28861

:100644 100644 7bbcbdbed9b8d2f447bd709966e5fd433bc8e6ab
52395cce691362d5abcdf3390436256c9e4b1018 M universal.c
:100644 100644 6be13df4a900051c9ccf1c044e2a14047cfcb647
dedd81a17da8cadaa3b5b01ab9d61cbf34f30257 M util.c
bisect run success
That took 2009 seconds

$ git show b5b5a8f
commit b5b5a8f
Author​: Rafael Garcia-Suarez <rgarciasuarez@​gmail.com>
Date​: Sun Sep 17 13​:32​:18 2006 +0000

  A better version of change #28847
  p4raw-link​: @​28847 on //depot/perl​:
e24f8a7
 
  p4raw-id​: //depot/perl@​28861

Inline Patch
diff --git a/universal.c b/universal.c
index 7bbcbdb..52395cc 100644
--- a/universal.c
+++ b/universal.c
@@ -688,7 +688,13 @@ XS(XS_version_qv)
 	    if ( SvNOK(ver) ) /* may get too much accuracy */
 	    {
 		char tbuf[64];
+#ifdef USE_LOCALE_NUMERIC
+		char *loc = setlocale(LC_NUMERIC, "C");
+#endif
 		const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf,
SvNVX(ver)); \+\#ifdef USE\_LOCALE\_NUMERIC \+ setlocale\(LC\_NUMERIC\, loc\); \+\#endif   version = savepvn\(tbuf\, len\);   \}   else
Inline Patch
diff --git a/util.c b/util.c
index 6be13df..dedd81a 100644
--- a/util.c
+++ b/util.c
@@ -4304,9 +4304,13 @@ Perl_upg_version(pTHX_ SV *ver)
     {
 	char tbuf[64];
 	STRLEN len;
-	SET_NUMERIC_STANDARD();
+#ifdef USE_LOCALE_NUMERIC
+	char *loc = setlocale(LC_NUMERIC, "C");
+#endif
 	len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
-	SET_NUMERIC_LOCAL();
+#ifdef USE_LOCALE_NUMERIC
+	setlocale(LC_NUMERIC, loc);
+#endif
 	while (tbuf[len-1] == '0' && len > 0) len--;
 	version = savepvn(tbuf, len);
     }


Reading the man page carefully, and a test program, suggests that we're not calling setlocale\(\) correctly\. It doesn't return the previous value\. It always returns the current value\. Hence to \*read\* it one has to use NULL\.

$ cat setlocale.c
#include <locale.h>
#include <stdio.h>

int
main(int argc, char **argv) {
  while (*++argv) {
printf("setlocale(LC_NUMERIC, NULL) returns '%s'\n",
  setlocale(LC_NUMERIC, NULL));
printf("setlocale(LC_NUMERIC, %s) returns '%s'\n",
  *argv, setlocale(LC_NUMERIC, *argv));
  }
  return 0;
}
$ ./setlocale POSIX
setlocale(LC_NUMERIC, NULL) returns 'C'
setlocale(LC_NUMERIC, POSIX) returns 'POSIX'

C patch coming soon, but it would be useful for someone else to write
regression tests.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Dec 13, 2011

From @JohnPeacock

On 12/09/2011 12​:47 PM, Ricardo Signes wrote​:

C patch coming soon, but it would be useful for someone else to write
regression tests.

I was actually working on this today. I will have a patch soon to move
all of the CPAN version.pm tests into the core tree, instead of trying
to maintain an independent test in blead. It turns out to be slightly
tricky to test this particular bug and I couldn't make it happen with my
existing locale tests. I'll keep banging on it...

John

@p5pRT
Copy link
Author

p5pRT commented Dec 18, 2011

From @JohnPeacock

On 12/09/2011 12​:47 PM, Ricardo Signes wrote​:

C patch coming soon, but it would be useful for someone else to write
regression tests.

Nicholas Clark

I have copied and modified a test from the CPAN version.pm release that
appears to trigger this bug, but I made the obvious change to the
version.pm code in the core​:

--- a/util.c
+++ b/util.c
@​@​ -4953,11 +4953,12 @​@​ Perl_upg_version(pTHX_ SV *ver, bool qv)
  /* may get too much accuracy */
  char tbuf[64];
  #ifdef USE_LOCALE_NUMERIC
- char *loc = setlocale(LC_NUMERIC, "C");
+ char *loc = setlocale(LC_NUMERIC, NULL); /* get the original
locale */
+ setlocale(LC_NUMERIC, "C");
  #endif
  STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff,
SvNVX(ver));
  #ifdef USE_LOCALE_NUMERIC
- setlocale(LC_NUMERIC, loc);
+ setlocale(LC_NUMERIC, loc); /* reset to original locale */
  #endif
  while (tbuf[len-1] == '0' && len > 0) len--;
  if ( tbuf[len-1] == '.' ) len--; /* eat the trailing decimal */

but A) this doesn't make the test pass and B) this code is not called by
require at all! HELP???

I'll keep digging, but if there was a proposed C patch (as described
above), I don't have it (and it isn't attached to the bug)...

John

@p5pRT
Copy link
Author

p5pRT commented Dec 18, 2011

From @nwc10

On Sun, Dec 18, 2011 at 05​:53​:50AM -0500, John Peacock wrote​:

On 12/09/2011 12​:47 PM, Ricardo Signes wrote​:

C patch coming soon, but it would be useful for someone else to write
regression tests.

"Coming soon" was because I tried the same "obvious" as you and it didn't
work.

--- a/util.c
+++ b/util.c
@​@​ -4953,11 +4953,12 @​@​ Perl_upg_version(pTHX_ SV *ver, bool qv)
/* may get too much accuracy */
char tbuf[64];
#ifdef USE_LOCALE_NUMERIC
- char *loc = setlocale(LC_NUMERIC, "C");
+ char *loc = setlocale(LC_NUMERIC, NULL); /* get the original
locale */
+ setlocale(LC_NUMERIC, "C");
#endif
STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff,
SvNVX(ver));
#ifdef USE_LOCALE_NUMERIC
- setlocale(LC_NUMERIC, loc);
+ setlocale(LC_NUMERIC, loc); /* reset to original locale */
#endif
while (tbuf[len-1] == '0' && len > 0) len--;
if ( tbuf[len-1] == '.' ) len--; /* eat the trailing decimal */

but A) this doesn't make the test pass and B) this code is not called by
require at all! HELP???

IIRC *that* code is called by the C<use 5.006;> in vars.pm which is used
by version.pm.

perl -Mlocale -MPOSIX -e 'my $i = 0.123; POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i); eval "use v5.0.0"; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b'
0,12 0.12 at -e line 1.

(gdb) where
#0 Perl_upg_version (my_perl=0x100800000, ver=0x10082b438, qv=false) at util.c​:4943
#1 0x000000010014d95e in Perl_new_version (my_perl=0x100800000, ver=0x10082b918) at util.c​:4925
#2 0x00000001002a4d25 in Perl_pp_require (my_perl=0x100800000) at pp_ctl.c​:3765
#3 0x000000010013d511 in Perl_runops_debug (my_perl=0x100800000) at dump.c​:2119
#4 0x00000001000470e5 in Perl_call_sv (my_perl=0x100800000, sv=0x100835dc8, flags=14) at perl.c​:2695
#5 0x00000001000568c7 in Perl_call_list (my_perl=0x100800000, oldscope=9, paramList=0x10081be70) at perl.c​:4768
#6 0x0000000100023294 in S_process_special_blocks (my_perl=0x100800000, fullname=0x10050d9e8 "BEGIN", gv=0x10081c140, cv=0x100835dc8) at op.c​:6860
#7 0x0000000100022f32 in Perl_newATTRSUB (my_perl=0x100800000, floor=173, o=0x10051abb0, proto=0x0, attrs=0x0, block=0x10051aab0) at op.c​:6830
#8 0x0000000100016370 in Perl_utilize (my_perl=0x100800000, aver=1, floor=173, version=0x0, idop=0x100516df0, arg=0x100511510) at op.c​:4662
#9 0x00000001000d3f47 in Perl_yyparse (my_perl=0x100800000, gramtype=258) at perly.y​:361
#10 0x00000001002a1e8a in S_doeval (my_perl=0x100800000, gimme=2, startop=0x0, outside=0x0, seq=4294967250, hh=0x0) at pp_ctl.c​:3589
#11 0x00000001002aa758 in Perl_pp_require (my_perl=0x100800000) at pp_ctl.c​:4146
#12 0x000000010013d511 in Perl_runops_debug (my_perl=0x100800000) at dump.c​:2119
#13 0x00000001000470e5 in Perl_call_sv (my_perl=0x100800000, sv=0x100817930, flags=14) at perl.c​:2695
#14 0x00000001000568c7 in Perl_call_list (my_perl=0x100800000, oldscope=2, paramList=0x1008179f0) at perl.c​:4768
#15 0x0000000100023294 in S_process_special_blocks (my_perl=0x100800000, fullname=0x10050d9e8 "BEGIN", gv=0x1008179c0, cv=0x100817930) at op.c​:6860
#16 0x0000000100022f32 in Perl_newATTRSUB (my_perl=0x100800000, floor=37, o=0x10050db60, proto=0x0, attrs=0x0, block=0x10050f4e0) at op.c​:6830
#17 0x0000000100016370 in Perl_utilize (my_perl=0x100800000, aver=1, floor=37, version=0x0, idop=0x100502b00, arg=0x0) at op.c​:4662
#18 0x00000001000d3f47 in Perl_yyparse (my_perl=0x100800000, gramtype=258) at perly.y​:361
#19 0x0000000100043fac in S_parse_body (my_perl=0x100800000, env=0x0, xsinit=0x100001369 <xs_init>) at perl.c​:2236
#20 0x0000000100041a51 in perl_parse (my_perl=0x100800000, xsinit=0x100001369 <xs_init>, argc=6, argv=0x7fff5fbfec50, env=0x0) at perl.c​:1634
#21 0x00000001000012af in main (argc=6, argv=0x7fff5fbfec50, env=0x7fff5fbfec88) at perlmain.c​:118

Karl had independently done it correctly (save a copy of the return value
from the first setlocale() call) and I didn't do anything further, as I
assumed that he was going to attach his working code to the ticket.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Dec 18, 2011

From @JohnPeacock

This is interesting​:

$ LC_NUMERIC=da_DK.utf8 ./perl -Ilib -Mlocale -MPOSIX -e 'my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),""); $a = sprintf("%.2f", $i); use
5.0; $b = sprintf("%.2f", $i); die setlocale(POSIX​::LC_NUMERIC());'
da_DK.utf8 at -e line 1.

$ LC_NUMERIC=da_DK.utf8 ./perl -Ilib -Mlocale -MPOSIX -e 'my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),""); $a = sprintf("%.2f", $i); eval
"use 5.0"; $b = sprintf("%.2f", $i); die setlocale(POSIX​::LC_NUMERIC());'
C at -e line 1.

So it has to do with the eval itself. The only thing that "use 5.0"
does is to trigger PL_patchlevel to be upgraded to a version object if
it isn't already one. But since that code uses upg_version, which goes
through the same save/restore path as everything else, it is a mystery
to me why this should be a problem.

I will note that this bug has been in every Perl release since 5.10.0...

John

@p5pRT
Copy link
Author

p5pRT commented Dec 18, 2011

From @khwilliamson

On 12/18/2011 04​:16 AM, Nicholas Clark wrote​:

On Sun, Dec 18, 2011 at 05​:53​:50AM -0500, John Peacock wrote​:

On 12/09/2011 12​:47 PM, Ricardo Signes wrote​:

C patch coming soon, but it would be useful for someone else to write
regression tests.

"Coming soon" was because I tried the same "obvious" as you and it didn't
work.

--- a/util.c
+++ b/util.c
@​@​ -4953,11 +4953,12 @​@​ Perl_upg_version(pTHX_ SV *ver, bool qv)
/* may get too much accuracy */
char tbuf[64];
#ifdef USE_LOCALE_NUMERIC
- char *loc = setlocale(LC_NUMERIC, "C");
+ char *loc = setlocale(LC_NUMERIC, NULL); /* get the original
locale */
+ setlocale(LC_NUMERIC, "C");
#endif
STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff,
SvNVX(ver));
#ifdef USE_LOCALE_NUMERIC
- setlocale(LC_NUMERIC, loc);
+ setlocale(LC_NUMERIC, loc); /* reset to original locale */
#endif
while (tbuf[len-1] == '0'&& len> 0) len--;
if ( tbuf[len-1] == '.' ) len--; /* eat the trailing decimal */

but A) this doesn't make the test pass and B) this code is not called by
require at all! HELP???

IIRC *that* code is called by the C<use 5.006;> in vars.pm which is used
by version.pm.

perl -Mlocale -MPOSIX -e 'my $i = 0.123; POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE"); $a = sprintf("%.2f", $i); eval "use v5.0.0"; $b = sprintf("%.2f", $i); die "$a $b" unless $a eq $b'
0,12 0.12 at -e line 1.

(gdb) where
#0 Perl_upg_version (my_perl=0x100800000, ver=0x10082b438, qv=false) at util.c​:4943
#1 0x000000010014d95e in Perl_new_version (my_perl=0x100800000, ver=0x10082b918) at util.c​:4925
#2 0x00000001002a4d25 in Perl_pp_require (my_perl=0x100800000) at pp_ctl.c​:3765
#3 0x000000010013d511 in Perl_runops_debug (my_perl=0x100800000) at dump.c​:2119
#4 0x00000001000470e5 in Perl_call_sv (my_perl=0x100800000, sv=0x100835dc8, flags=14) at perl.c​:2695
#5 0x00000001000568c7 in Perl_call_list (my_perl=0x100800000, oldscope=9, paramList=0x10081be70) at perl.c​:4768
#6 0x0000000100023294 in S_process_special_blocks (my_perl=0x100800000, fullname=0x10050d9e8 "BEGIN", gv=0x10081c140, cv=0x100835dc8) at op.c​:6860
#7 0x0000000100022f32 in Perl_newATTRSUB (my_perl=0x100800000, floor=173, o=0x10051abb0, proto=0x0, attrs=0x0, block=0x10051aab0) at op.c​:6830
#8 0x0000000100016370 in Perl_utilize (my_perl=0x100800000, aver=1, floor=173, version=0x0, idop=0x100516df0, arg=0x100511510) at op.c​:4662
#9 0x00000001000d3f47 in Perl_yyparse (my_perl=0x100800000, gramtype=258) at perly.y​:361
#10 0x00000001002a1e8a in S_doeval (my_perl=0x100800000, gimme=2, startop=0x0, outside=0x0, seq=4294967250, hh=0x0) at pp_ctl.c​:3589
#11 0x00000001002aa758 in Perl_pp_require (my_perl=0x100800000) at pp_ctl.c​:4146
#12 0x000000010013d511 in Perl_runops_debug (my_perl=0x100800000) at dump.c​:2119
#13 0x00000001000470e5 in Perl_call_sv (my_perl=0x100800000, sv=0x100817930, flags=14) at perl.c​:2695
#14 0x00000001000568c7 in Perl_call_list (my_perl=0x100800000, oldscope=2, paramList=0x1008179f0) at perl.c​:4768
#15 0x0000000100023294 in S_process_special_blocks (my_perl=0x100800000, fullname=0x10050d9e8 "BEGIN", gv=0x1008179c0, cv=0x100817930) at op.c​:6860
#16 0x0000000100022f32 in Perl_newATTRSUB (my_perl=0x100800000, floor=37, o=0x10050db60, proto=0x0, attrs=0x0, block=0x10050f4e0) at op.c​:6830
#17 0x0000000100016370 in Perl_utilize (my_perl=0x100800000, aver=1, floor=37, version=0x0, idop=0x100502b00, arg=0x0) at op.c​:4662
#18 0x00000001000d3f47 in Perl_yyparse (my_perl=0x100800000, gramtype=258) at perly.y​:361
#19 0x0000000100043fac in S_parse_body (my_perl=0x100800000, env=0x0, xsinit=0x100001369<xs_init>) at perl.c​:2236
#20 0x0000000100041a51 in perl_parse (my_perl=0x100800000, xsinit=0x100001369<xs_init>, argc=6, argv=0x7fff5fbfec50, env=0x0) at perl.c​:1634
#21 0x00000001000012af in main (argc=6, argv=0x7fff5fbfec50, env=0x7fff5fbfec88) at perlmain.c​:118

Karl had independently done it correctly (save a copy of the return value
from the first setlocale() call) and I didn't do anything further, as I
assumed that he was going to attach his working code to the ticket.

Nicholas Clark

And Karl didn't do anything because he thought he saw Nicholas on irc
say he was nominating rjbs to finish things up, and rjbs didn't protest,
so I still think it is all in his hands.

@p5pRT
Copy link
Author

p5pRT commented Dec 18, 2011

From @nwc10

On Sun, Dec 18, 2011 at 09​:39​:37AM -0700, Karl Williamson wrote​:

And Karl didn't do anything because he thought he saw Nicholas on irc
say he was nominating rjbs to finish things up, and rjbs didn't protest,
so I still think it is all in his hands.

Yes, sorry, forgot that bit.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2011

From @cpansprout

On Fri Dec 09 05​:48​:11 2011, rjbs wrote​:

This is a bug report for perl from rjbs@​cpan.org,
generated with the help of perlbug 1.39 running under perl 5.14.2.

-----------------------------------------------------------------
[Please describe your issue here]

Loading version.pm seems to blow away locale settings. Here's a
program​:

use strict;
use locale;
use POSIX;
my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE");
printf("%.2f\n", $i);
require version;
printf("%.2f\n", $i);

This is worse than it seems. This came up when version was loaded by
"use
5.005" in constant.pm -- so loading anything at runtime that has a
"use
VERSION" check loads version.pm, killing locales.

Did 909d378 fix this?

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2011

From @khwilliamson

On 12/18/2011 09​:30 PM, Father Chrysostomos via RT wrote​:

On Fri Dec 09 05​:48​:11 2011, rjbs wrote​:

This is a bug report for perl from rjbs@​cpan.org,
generated with the help of perlbug 1.39 running under perl 5.14.2.

-----------------------------------------------------------------
[Please describe your issue here]

Loading version.pm seems to blow away locale settings. Here's a
program​:

use strict;
use locale;
use POSIX;
my $i = 0.123;
POSIX​::setlocale(POSIX​::LC_NUMERIC(),"de_DE");
printf("%.2f\n", $i);
require version;
printf("%.2f\n", $i);

This is worse than it seems. This came up when version was loaded by
"use
5.005" in constant.pm -- so loading anything at runtime that has a
"use
VERSION" check loads version.pm, killing locales.

Did 909d378 fix this?

It is my belief that it did.

@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2011

From @JohnPeacock

On 12/18/2011 11​:30 PM, Father Chrysostomos via RT wrote​:

On Fri Dec 09 05​:48​:11 2011, rjbs wrote​:

This is worse than it seems. This came up when version was loaded by
"use
5.005" in constant.pm -- so loading anything at runtime that has a
"use
VERSION" check loads version.pm, killing locales.

Did 909d378 fix this?

Yes it did! Wow, that was subtle...

John

@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2011

@cpansprout - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant