develooper Front page | perl.perl5.porters | Postings from December 2011

[perl #105784] version.pm blows away locale

From:
Ricardo Signes
Date:
December 9, 2011 09:47
Subject:
[perl #105784] version.pm blows away locale
Message ID:
20111209174705.GA15445@cancer.codesimply.com
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
a7ad731c5ef0d5f23c440149f8f810a4785a2903 -- ./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
b5b5a8f0780c94d6973849925747efe92490a7da is the first bad commit
commit b5b5a8f0780c94d6973849925747efe92490a7da
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:
e24f8a798207476769992a3387804af506c43eab

    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 b5b5a8f0780c94d6973849925747efe92490a7da
commit b5b5a8f0780c94d6973849925747efe92490a7da
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:
e24f8a798207476769992a3387804af506c43eab
    
    p4raw-id: //depot/perl@28861

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
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



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About