From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 17 Jun 1999 22:42:03 +0000 (+0000)
Subject: Fixed two long-standing locale bugs.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=097ee67dff1c60f201bc09435bc6eaeeafcd8123;p=p5sagit%2Fp5-mst-13.2.git

Fixed two long-standing locale bugs.

Both problems were related to numeric locale which
controls the radix character aka the decimal separator.
(1) printf (and sprintf) were resetting the numeric locale to C.
(2) Using locale-numerically formatted floating point
    numbers (e.g. "1,23") together with -w caused warnings about
    "isn't numeric".  The operations were working fine, though,
    because atof() was using the local locale.
Both problems reported by Stefan Vogtner.

Introduced a wrapper for atof() that attempts to convert
the string both ways.  This helps Perl to understand
numbers like this "4.56" even when using a local locale
makes atof() understand only numbers like this "7,89".

Remaining related problems, both of which existed before
this patch and continue to exist after this patch:
(a) The behaviour of print() is _not_ as documented by perllocale.
    Instead of always using the C locale, print() does use the
    local locale, just like the *printf() do.  This may be fixable
    now that switching to-and-fro between locales has been made
    more consistent, but fixing print() would change existing
    behaviour.  perllocale is not changed by this patch.
(b) If a number has been stringified (say, via "$number") under
    a local locale, the cached string value persists even under
    "no locale".  This may or may not be a problem: operations
    work fine because the original number is still there, but
    that the string form keeps its locale-ish outlook may be
    somewhat confusing.

p4raw-id: //depot/cfgperl@3542
---

diff --git a/dump.c b/dump.c
index ef0d858..3d3a55c 100644
--- a/dump.c
+++ b/dump.c
@@ -277,8 +277,9 @@ Perl_sv_peek(pTHX_ SV *sv)
 	}
     }
     else if (SvNOKp(sv)) {
-	SET_NUMERIC_STANDARD();
+ 	RESTORE_NUMERIC_STANDARD();
 	Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv));
+ 	RESTORE_NUMERIC_LOCAL();
     }
     else if (SvIOKp(sv)) {		/* XXXX: IV, UV? */
 	if (SvIsUV(sv))
@@ -895,8 +896,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	PerlIO_putc(file, '\n');
     }
     if (type >= SVt_PVNV || type == SVt_NV) {
-	SET_NUMERIC_STANDARD();
+	RESTORE_NUMERIC_STANDARD();
 	Perl_dump_indent(aTHX_ level, file, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
+	RESTORE_NUMERIC_LOCAL();
     }
     if (SvROK(sv)) {
 	Perl_dump_indent(aTHX_ level, file, "  RV = 0x%lx\n", (long)SvRV(sv));
diff --git a/embed.h b/embed.h
index 17acf1e..02a2cc2 100644
--- a/embed.h
+++ b/embed.h
@@ -311,6 +311,9 @@
 #define mod			Perl_mod
 #define moreswitches		Perl_moreswitches
 #define my			Perl_my
+#ifdef USE_LOCALE_NUMERIC
+#define my_atof			Perl_my_atof
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 #define my_bcopy		Perl_my_bcopy
 #endif
@@ -423,6 +426,7 @@
 #define new_ctype		Perl_new_ctype
 #define new_numeric		Perl_new_numeric
 #define set_numeric_local	Perl_set_numeric_local
+#define set_numeric_radix	Perl_set_numeric_radix
 #define set_numeric_standard	Perl_set_numeric_standard
 #define require_pv		Perl_require_pv
 #define pidgone			Perl_pidgone
@@ -1612,6 +1616,9 @@
 #define mod(a,b)		Perl_mod(aTHX_ a,b)
 #define moreswitches(a)		Perl_moreswitches(aTHX_ a)
 #define my(a)			Perl_my(aTHX_ a)
+#ifdef USE_LOCALE_NUMERIC
+#define my_atof(a)		Perl_my_atof(aTHX_ a)
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 #define my_bcopy(a,b,c)		Perl_my_bcopy(aTHX_ a,b,c)
 #endif
@@ -1723,6 +1730,7 @@
 #define new_ctype(a)		Perl_new_ctype(aTHX_ a)
 #define new_numeric(a)		Perl_new_numeric(aTHX_ a)
 #define set_numeric_local()	Perl_set_numeric_local(aTHX)
+#define set_numeric_radix()	Perl_set_numeric_radix(aTHX)
 #define set_numeric_standard()	Perl_set_numeric_standard(aTHX)
 #define require_pv(a)		Perl_require_pv(aTHX_ a)
 #define pidgone(a,b)		Perl_pidgone(aTHX_ a,b)
@@ -2917,6 +2925,9 @@
 #define Perl_mod		CPerlObj::mod
 #define Perl_moreswitches	CPerlObj::moreswitches
 #define Perl_my			CPerlObj::my
+#ifdef USE_LOCALE_NUMERIC
+#define Perl_my_atof		CPerlObj::my_atof
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 #define Perl_my_bcopy		CPerlObj::my_bcopy
 #endif
@@ -3029,6 +3040,7 @@
 #define Perl_new_ctype		CPerlObj::new_ctype
 #define Perl_new_numeric	CPerlObj::new_numeric
 #define Perl_set_numeric_local	CPerlObj::set_numeric_local
+#define Perl_set_numeric_radix	CPerlObj::set_numeric_radix
 #define Perl_set_numeric_standard	CPerlObj::set_numeric_standard
 #define Perl_require_pv		CPerlObj::require_pv
 #define Perl_pidgone		CPerlObj::pidgone
diff --git a/embed.pl b/embed.pl
index eb0d42c..6816740 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1040,6 +1040,9 @@ p	|I32	|mg_size	|SV* sv
 p	|OP*	|mod		|OP* o|I32 type
 p	|char*	|moreswitches	|char* s
 p	|OP*	|my		|OP* o
+#ifdef USE_LOCALE_NUMERIC
+p	|double	|my_atof	|const char *s
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 p	|char*	|my_bcopy	|const char* from|char* to|I32 len
 #endif
@@ -1159,6 +1162,7 @@ p	|void	|new_collate	|const char* newcoll
 p	|void	|new_ctype	|const char* newctype
 p	|void	|new_numeric	|const char* newcoll
 p	|void	|set_numeric_local
+p	|void	|set_numeric_radix
 p	|void	|set_numeric_standard
 no	|int	|perl_parse	|PerlInterpreter* sv_interp|XSINIT_t xsinit \
 				|int argc|char** argv|char** env
diff --git a/embedvar.h b/embedvar.h
index 1312258..dbd94e9 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -428,6 +428,7 @@
 #define PL_nthreads_cond	(PL_curinterp->Inthreads_cond)
 #define PL_numeric_local	(PL_curinterp->Inumeric_local)
 #define PL_numeric_name		(PL_curinterp->Inumeric_name)
+#define PL_numeric_radix	(PL_curinterp->Inumeric_radix)
 #define PL_numeric_standard	(PL_curinterp->Inumeric_standard)
 #define PL_ofmt			(PL_curinterp->Iofmt)
 #define PL_oldbufptr		(PL_curinterp->Ioldbufptr)
@@ -684,6 +685,7 @@
 #define PL_Inthreads_cond	PL_nthreads_cond
 #define PL_Inumeric_local	PL_numeric_local
 #define PL_Inumeric_name	PL_numeric_name
+#define PL_Inumeric_radix	PL_numeric_radix
 #define PL_Inumeric_standard	PL_numeric_standard
 #define PL_Iofmt		PL_ofmt
 #define PL_Ioldbufptr		PL_oldbufptr
diff --git a/global.sym b/global.sym
index f3e6494..0c3f72b 100644
--- a/global.sym
+++ b/global.sym
@@ -280,6 +280,7 @@ Perl_mg_size
 Perl_mod
 Perl_moreswitches
 Perl_my
+Perl_my_atof
 Perl_my_bcopy
 Perl_my_bzero
 Perl_my_exit
@@ -382,6 +383,7 @@ Perl_new_collate
 Perl_new_ctype
 Perl_new_numeric
 Perl_set_numeric_local
+Perl_set_numeric_radix
 Perl_set_numeric_standard
 perl_parse
 Perl_require_pv
diff --git a/intrpvar.h b/intrpvar.h
index 744ff31..0bf826e 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -315,6 +315,8 @@ PERLVARI(Inumeric_standard,	bool,	TRUE)
 					/* Assume simple numerics */
 PERLVARI(Inumeric_local,	bool,	TRUE)
 					/* Assume local numerics */
+PERLVAR(Inumeric_radix,		char)
+					/* The radix character if not '.' */
 
 #endif /* !USE_LOCALE_NUMERIC */
 
diff --git a/mg.c b/mg.c
index 96e4bd2..30253bc 100644
--- a/mg.c
+++ b/mg.c
@@ -1941,10 +1941,9 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    char *p = SvPV(sv, len);
 	    Groups_t gary[NGROUPS];
 
-	    SET_NUMERIC_STANDARD();
 	    while (isSPACE(*p))
 		++p;
-	    PL_egid = I_V(atof(p));
+	    PL_egid = I_V(atol(p));
 	    for (i = 0; i < NGROUPS; ++i) {
 		while (*p && !isSPACE(*p))
 		    ++p;
@@ -1952,7 +1951,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		    ++p;
 		if (!*p)
 		    break;
-		gary[i] = I_V(atof(p));
+		gary[i] = I_V(atol(p));
 	    }
 	    if (i)
 		(void)setgroups(i, gary);
diff --git a/objXSUB.h b/objXSUB.h
index 579b916..c15c19d 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -406,6 +406,8 @@
 #define PL_numeric_local	pPerl->PL_numeric_local
 #undef  PL_numeric_name
 #define PL_numeric_name		pPerl->PL_numeric_name
+#undef  PL_numeric_radix
+#define PL_numeric_radix	pPerl->PL_numeric_radix
 #undef  PL_numeric_standard
 #define PL_numeric_standard	pPerl->PL_numeric_standard
 #undef  PL_ofmt
@@ -1361,6 +1363,10 @@
 #define moreswitches		pPerl->moreswitches
 #undef  my
 #define my			pPerl->my
+#ifdef USE_LOCALE_NUMERIC
+#undef  my_atof
+#define my_atof			pPerl->my_atof
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 #undef  my_bcopy
 #define my_bcopy		pPerl->my_bcopy
@@ -1571,6 +1577,8 @@
 #define new_numeric		pPerl->new_numeric
 #undef  set_numeric_local
 #define set_numeric_local	pPerl->set_numeric_local
+#undef  set_numeric_radix
+#define set_numeric_radix	pPerl->set_numeric_radix
 #undef  set_numeric_standard
 #define set_numeric_standard	pPerl->set_numeric_standard
 #undef  require_pv
diff --git a/perl.c b/perl.c
index 6be4342..92c2eaf 100644
--- a/perl.c
+++ b/perl.c
@@ -964,7 +964,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	    Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
 	else {
 	    Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
-		PL_origfilename);
+		       PL_origfilename);
 	}
     }
     PL_curcop->cop_line = 0;
diff --git a/perl.h b/perl.h
index 60a41ea..7ef9432 100644
--- a/perl.h
+++ b/perl.h
@@ -2817,10 +2817,22 @@ typedef struct am_table_short AMTS;
 	    set_numeric_local();		\
     } STMT_END
 
+#define IS_NUMERIC_RADIX(c)	\
+	((PL_hints & HINT_LOCALE) && \
+	  PL_numeric_radix && (c) == PL_numeric_radix)
+
+#define RESTORE_NUMERIC_LOCAL()		if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
+#define RESTORE_NUMERIC_STANDARD()	if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
+#define Atof(s)				Perl_my_atof(s)
+
 #else /* !USE_LOCALE_NUMERIC */
 
-#define SET_NUMERIC_STANDARD()  /**/
-#define SET_NUMERIC_LOCAL()     /**/
+#define SET_NUMERIC_STANDARD()  	/**/
+#define SET_NUMERIC_LOCAL()     	/**/
+#define IS_NUMERIC_RADIX(c)		(0)
+#define RESTORE_NUMERIC_LOCAL()		/**/
+#define RESTORE_NUMERIC_STANDARD()	/**/
+#define Atof(s)				atof(s)
 
 #endif /* !USE_LOCALE_NUMERIC */
 
diff --git a/pp.c b/pp.c
index 8874b30..a42c611 100644
--- a/pp.c
+++ b/pp.c
@@ -1802,7 +1802,7 @@ PP(pp_log)
       double value;
       value = POPn;
       if (value <= 0.0) {
-	SET_NUMERIC_STANDARD();
+	RESTORE_NUMERIC_STANDARD();
 	DIE(aTHX_ "Can't take log of %g", value);
       }
       value = log(value);
@@ -1818,7 +1818,7 @@ PP(pp_sqrt)
       double value;
       value = POPn;
       if (value < 0.0) {
-	SET_NUMERIC_STANDARD();
+	RESTORE_NUMERIC_STANDARD();
 	DIE(aTHX_ "Can't take sqrt of %g", value);
       }
       value = sqrt(value);
@@ -2204,12 +2204,6 @@ PP(pp_rindex)
 PP(pp_sprintf)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
-#ifdef USE_LOCALE_NUMERIC
-    if (PL_op->op_private & OPpLOCALE)
-	SET_NUMERIC_LOCAL();
-    else
-	SET_NUMERIC_STANDARD();
-#endif
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
     SP = ORIGMARK;
diff --git a/pp_ctl.c b/pp_ctl.c
index 436498f..e4a7411 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -567,11 +567,16 @@ PP(pp_formline)
 	    gotsome = TRUE;
 	    value = SvNV(sv);
 	    /* Formats aren't yet marked for locales, so assume "yes". */
-	    SET_NUMERIC_LOCAL();
-	    if (arg & 256) {
-		sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value);
-	    } else {
-		sprintf(t, "%*.0f", (int) fieldsize, value);
+	    {
+		RESTORE_NUMERIC_LOCAL();
+		if (arg & 256) {
+		    sprintf(t, "%#*.*f",
+			    (int) fieldsize, (int) arg & 255, value);
+		} else {
+		    sprintf(t, "%*.0f",
+			    (int) fieldsize, value);
+		}
+		RESTORE_NUMERIC_STANDARD();
 	    }
 	    t += fieldsize;
 	    break;
@@ -2727,7 +2732,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
 	PERL_CONTEXT *cx;
 	I32 optype = 0;			/* Might be reset by POPEVAL. */
 	STRLEN n_a;
-
+	
 	PL_op = saveop;
 	if (PL_eval_root) {
 	    op_free(PL_eval_root);
@@ -2854,8 +2859,7 @@ PP(pp_require)
 
     sv = POPs;
     if (SvNIOKp(sv) && !SvPOKp(sv)) {
-	SET_NUMERIC_STANDARD();
-	if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
+	if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
 	    DIE(aTHX_ "Perl %s required--this is only version %s, stopped",
 		SvPV(sv,n_a),PL_patchlevel);
 	RETPUSHYES;
diff --git a/pp_sys.c b/pp_sys.c
index 8eee944..9600174 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1356,12 +1356,6 @@ PP(pp_prtf)
 	goto just_say_no;
     }
     else {
-#ifdef USE_LOCALE_NUMERIC
-	if (PL_op->op_private & OPpLOCALE)
-	    SET_NUMERIC_LOCAL();
-	else
-	    SET_NUMERIC_STANDARD();
-#endif
 	do_sprintf(sv, SP - MARK, MARK + 1);
 	if (!do_print(sv, fp))
 	    goto just_say_no;
diff --git a/proto.h b/proto.h
index 222654c..5251b5f 100644
--- a/proto.h
+++ b/proto.h
@@ -304,6 +304,9 @@ I32	Perl_mg_size(pTHX_ SV* sv);
 OP*	Perl_mod(pTHX_ OP* o, I32 type);
 char*	Perl_moreswitches(pTHX_ char* s);
 OP*	Perl_my(pTHX_ OP* o);
+#ifdef USE_LOCALE_NUMERIC
+double	Perl_my_atof(pTHX_ const char *s);
+#endif
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 char*	Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len);
 #endif
@@ -420,6 +423,7 @@ void	Perl_new_collate(pTHX_ const char* newcoll);
 void	Perl_new_ctype(pTHX_ const char* newctype);
 void	Perl_new_numeric(pTHX_ const char* newcoll);
 void	Perl_set_numeric_local(pTHX);
+void	Perl_set_numeric_radix(pTHX);
 void	Perl_set_numeric_standard(pTHX);
 int	perl_parse(PerlInterpreter* sv_interp, XSINIT_t xsinit, int argc, char** argv, char** env);
 void	Perl_require_pv(pTHX_ const char* pv);
diff --git a/sv.c b/sv.c
index edf1f1e..5fad33e 100644
--- a/sv.c
+++ b/sv.c
@@ -1210,8 +1210,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	     * - otherwise future conversion to NV will be wrong.  */
 	    double d;
 
-	    SET_NUMERIC_STANDARD();
-	    d = atof(SvPVX(sv));
+	    d = Atof(SvPVX(sv));
 
 	    if (SvTYPE(sv) < SVt_PVNV)
 		sv_upgrade(sv, SVt_PVNV);
@@ -1351,8 +1350,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	     * - otherwise future conversion to NV will be wrong.  */
 	    double d;
 
-	    SET_NUMERIC_STANDARD();
-	    d = atof(SvPVX(sv));	/* XXXX 64-bit? */
+	    d = Atof(SvPVX(sv));	/* XXXX 64-bit? */
 
 	    if (SvTYPE(sv) < SVt_PVNV)
 		sv_upgrade(sv, SVt_PVNV);
@@ -1435,8 +1433,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    dTHR;
 	    if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 		not_a_number(sv);
-	    SET_NUMERIC_STANDARD();
-	    return atof(SvPVX(sv));
+	    return Atof(SvPVX(sv));
 	}
 	if (SvIOKp(sv)) {
 	    if (SvIsUV(sv)) 
@@ -1465,8 +1462,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    if (SvPOKp(sv) && SvLEN(sv)) {
 		if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 		    not_a_number(sv);
-		SET_NUMERIC_STANDARD();
-		return atof(SvPVX(sv));
+		return Atof(SvPVX(sv));
 	    }
 	    if (SvIOKp(sv)) {
 		if (SvIsUV(sv)) 
@@ -1484,9 +1480,12 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    sv_upgrade(sv, SVt_PVNV);
 	else
 	    sv_upgrade(sv, SVt_NV);
-	DEBUG_c(SET_NUMERIC_STANDARD());
-	DEBUG_c(PerlIO_printf(Perl_debug_log,
-			      "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
+	DEBUG_c({
+	    RESTORE_NUMERIC_STANDARD();
+	    PerlIO_printf(Perl_debug_log,
+			  "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv));
+	    RESTORE_NUMERIC_LOCAL();
+	});
     }
     else if (SvTYPE(sv) < SVt_PVNV)
 	sv_upgrade(sv, SVt_PVNV);
@@ -1499,8 +1498,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	dTHR;
 	if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 	    not_a_number(sv);
-	SET_NUMERIC_STANDARD();
-	SvNVX(sv) = atof(SvPVX(sv));
+	SvNVX(sv) = Atof(SvPVX(sv));
     }
     else  {
 	dTHR;
@@ -1512,9 +1510,12 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	return 0.0;
     }
     SvNOK_on(sv);
-    DEBUG_c(SET_NUMERIC_STANDARD());
-    DEBUG_c(PerlIO_printf(Perl_debug_log,
-			  "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
+    DEBUG_c({
+	RESTORE_NUMERIC_STANDARD();
+	PerlIO_printf(Perl_debug_log,
+		      "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv));
+	RESTORE_NUMERIC_LOCAL();
+    });
     return SvNVX(sv);
 }
 
@@ -1531,8 +1532,7 @@ S_asIV(pTHX_ SV *sv)
 	if (ckWARN(WARN_NUMERIC))
 	    not_a_number(sv);
     }
-    SET_NUMERIC_STANDARD();
-    d = atof(SvPVX(sv));
+    d = Atof(SvPVX(sv));
     return I_V(d);
 }
 
@@ -1550,8 +1550,7 @@ S_asUV(pTHX_ SV *sv)
 	if (ckWARN(WARN_NUMERIC))
 	    not_a_number(sv);
     }
-    SET_NUMERIC_STANDARD();
-    return U_V(atof(SvPVX(sv)));
+    return U_V(Atof(SvPVX(sv)));
 }
 
 /*
@@ -1601,11 +1600,12 @@ Perl_looks_like_number(pTHX_ SV *sv)
 
     nbegin = s;
     /*
-     * we return 1 if the number can be converted to _integer_ with atol()
-     * and 2 if you need (int)atof().
+     * we return IS_NUMBER_TO_INT_BY_ATOL if the number can be converted
+     * to _integer_ with atol() and IS_NUMBER_TO_INT_BY_ATOF if you need
+     * (int)atof().
      */
 
-    /* next must be digit or '.' */
+    /* next must be digit or the radix separator */
     if (isDIGIT(*s)) {
         do {
 	    s++;
@@ -1616,17 +1616,25 @@ Perl_looks_like_number(pTHX_ SV *sv)
 	else
 	    numtype |= IS_NUMBER_TO_INT_BY_ATOL;
 
-        if (*s == '.') {
+        if (*s == '.'
+#ifdef USE_LOCALE_NUMERIC 
+	    || IS_NUMERIC_RADIX(*s)
+#endif
+	    ) {
 	    s++;
 	    numtype |= IS_NUMBER_NOT_IV;
-            while (isDIGIT(*s))  /* optional digits after "." */
+            while (isDIGIT(*s))  /* optional digits after the radix */
                 s++;
         }
     }
-    else if (*s == '.') {
+    else if (*s == '.'
+#ifdef USE_LOCALE_NUMERIC 
+	    || IS_NUMERIC_RADIX(*s)
+#endif
+	    ) {
         s++;
 	numtype |= IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_IV;
-        /* no digits before '.' means we need digits after it */
+        /* no digits before the radix means we need digits after it */
         if (isDIGIT(*s)) {
 	    do {
 	        s++;
@@ -1725,7 +1733,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	    goto tokensave;
 	}
 	if (SvNOKp(sv)) {
-	    SET_NUMERIC_STANDARD();
 	    Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
 	    tsv = Nullsv;
 	    goto tokensave;
@@ -1829,7 +1836,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	if (SvREADONLY(sv)) {
 	    if (SvNOKp(sv)) {		/* See note in sv_2uv() */
 		/* XXXX 64-bit?  IV may have better precision... */
-		SET_NUMERIC_STANDARD();
 		Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
 		tsv = Nullsv;
 		goto tokensave;
@@ -1867,7 +1873,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	else
 #endif /*apollo*/
 	{
-	    SET_NUMERIC_STANDARD();
 	    Gconvert(SvNVX(sv), DBL_DIG, 0, s);
 	}
 	errno = olderrno;
@@ -3766,8 +3771,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
     while (isALPHA(*d)) d++;
     while (isDIGIT(*d)) d++;
     if (*d) {
-	SET_NUMERIC_STANDARD();
-	sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
+	sv_setnv(sv,Atof(SvPVX(sv)) + 1.0);  /* punt */
 	return;
     }
     d--;
@@ -3866,8 +3870,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
 	(void)SvNOK_only(sv);
 	return;
     }
-    SET_NUMERIC_STANDARD();
-    sv_setnv(sv,atof(SvPVX(sv)) - 1.0);	/* punt */
+    sv_setnv(sv,Atof(SvPVX(sv)) - 1.0);	/* punt */
 }
 
 /* Make a string that will exist for the duration of the expression
@@ -5086,7 +5089,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		*--eptr = '#';
 	    *--eptr = '%';
 
-	    (void)sprintf(PL_efloatbuf, eptr, nv);
+	    {
+		RESTORE_NUMERIC_STANDARD();
+		(void)sprintf(PL_efloatbuf, eptr, nv);
+		RESTORE_NUMERIC_LOCAL();
+	    }
 
 	    eptr = PL_efloatbuf;
 	    elen = strlen(PL_efloatbuf);
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index b53a228..760bc4b 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -21,23 +21,15 @@ eval {
     $have_setlocale++;
 };
 
-use vars qw(&LC_ALL);
-
 # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
 # and mingw32 uses said silly CRT
 $have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
 
-# 103 (the last test) may fail but that is sort-of okay.
-# (It indicates something broken in the environment, not Perl)
-
-print "1..", ($have_setlocale ? 103 : 98), "\n";
+print "1..", ($have_setlocale ? 114 : 98), "\n";
 
-use vars qw($a
-	    $English $German $French $Spanish
-	    @C @English @German @French @Spanish
-	    $Locale @Locale %UPPER %lower %bothcase @Neoalpha);
+use vars qw(&LC_ALL);
 
-$a = 'abc %';
+my $a = 'abc %';
 
 sub ok {
     my ($n, $result) = @_;
@@ -236,7 +228,6 @@ Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW tw.EUC
 Croation:hr:hr:2
 Czech:cs:cz:2
 Danish:dk:da:1
-Danish:dk:da:1
 Dutch:nl:nl:1
 English American British:en:au ca gb ie nz us uk:1 cp850
 Estonian:et:ee:1
@@ -302,8 +293,12 @@ trylocale("C");
 trylocale("POSIX");
 foreach (0..15) {
     trylocale("ISO8859-$_");
-    trylocale("iso_8859_$_");
     trylocale("iso8859$_");
+    trylocale("iso8859-$_");
+    trylocale("iso_8859_$_");
+    trylocale("isolatin$_");
+    trylocale("isolatin-$_");
+    trylocale("iso_latin_$_");
 }
 
 foreach my $locale (split(/\n/, $locales)) {
@@ -350,6 +345,7 @@ sub debugf {
 debug "# Locales = @Locale\n";
 
 my %Problem;
+my @Neoalpha;
 
 foreach $Locale (@Locale) {
     debug "# Locale = $Locale\n";
@@ -365,7 +361,9 @@ foreach $Locale (@Locale) {
 
     # Sieve the uppercase and the lowercase.
     
-    %UPPER = %lower = %bothcase = ();
+    my %UPPER = ();
+    my %lower = ();
+    my %BoThCaSe = ();
     for (@Alnum_) {
 	if (/[^\d_]/) { # skip digits and the _
 	    if (uc($_) eq $_) {
@@ -377,19 +375,19 @@ foreach $Locale (@Locale) {
 	}
     }
     foreach (keys %UPPER) {
-	$bothcase{$_}++ if exists $lower{$_};
+	$BoThCaSe{$_}++ if exists $lower{$_};
     }
     foreach (keys %lower) {
-	$bothcase{$_}++ if exists $UPPER{$_};
+	$BoThCaSe{$_}++ if exists $UPPER{$_};
     }
-    foreach (keys %bothcase) {
+    foreach (keys %BoThCaSe) {
 	delete $UPPER{$_};
 	delete $lower{$_};
     }
 
     debug "# UPPER    = ", join(" ", sort keys %UPPER   ), "\n";
     debug "# lower    = ", join(" ", sort keys %lower   ), "\n";
-    debug "# bothcase = ", join(" ", sort keys %bothcase), "\n";
+    debug "# BoThCaSe = ", join(" ", sort keys %BoThCaSe), "\n";
 
     # Find the alphabets that are not alphabets in the default locale.
 
@@ -426,43 +424,33 @@ foreach $Locale (@Locale) {
 	}
     }
 
-    # Test #100 removed but to preserve historical test number
-    # consistency we do not renumber the remaining tests.
-
     # Cross-check whole character set.
 
-    debug "# testing 101 with locale '$Locale'\n";
+    debug "# testing 100 with locale '$Locale'\n";
     for (map { chr } 0..255) {
 	if ((/\w/ and /\W/) or (/\d/ and /\D/) or (/\s/ and /\S/)) {
-	    $Problem{101}{$Locale} = 1;
-	    debug "# failed 101\n";
+	    $Problem{100}{$Locale} = 1;
+	    debug "# failed 100\n";
 	    last;
 	}
     }
 
     # Test for read-only scalars' locale vs non-locale comparisons.
 
-    debug "# testing 102 with locale '$Locale'\n";
+    debug "# testing 101 with locale '$Locale'\n";
     {
 	no locale;
 	$a = "qwerty";
 	{
 	    use locale;
 	    if ($a cmp "qwerty") {
-		$Problem{102}{$Locale} = 1;
-		debug "# failed 102\n";
+		$Problem{101}{$Locale} = 1;
+		debug "# failed 101\n";
 	    }
 	}
     }
 
-    # This test must be the last one because its failure is not fatal.
-    # The @Alnum_ should be internally consistent.
-    # Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
-    # for inventing a way to test for ordering consistency
-    # without requiring any particular order.
-    # <jhi@iki.fi>
-    
-    debug "# testing 103 with locale '$Locale'\n";
+    debug "# testing 102 with locale '$Locale'\n";
     {
 	my ($from, $to, $lesser, $greater,
 	    @test, %test, $test, $yes, $no, $sign);
@@ -500,8 +488,8 @@ foreach $Locale (@Locale) {
 	    $test = 0;
 	    for my $ti (@test) { $test{$ti} = eval $ti ; $test ||= $test{$ti} }
 	    if ($test) {
-		$Problem{103}{$Locale} = 1;
-		debug "# failed 103 at:\n";
+		$Problem{102}{$Locale} = 1;
+		debug "# failed 102 at:\n";
 		debug "# lesser  = '$lesser'\n";
 		debug "# greater = '$greater'\n";
 		debug "# lesser cmp greater = ", $lesser cmp $greater, "\n";
@@ -522,12 +510,10 @@ foreach $Locale (@Locale) {
     }
 }
 
-no locale;
-
-foreach (99..103) {
+foreach (99..102) {
     if ($Problem{$_}) {
-	if ($_ == 103) {
-	    print "# The failure of test 103 is not necessarily fatal.\n";
+	if ($_ == 102) {
+	    print "# The failure of test 102 is not necessarily fatal.\n";
 	    print "# It usually indicates a problem in the enviroment,\n";
 	    print "# not in Perl itself.\n";
 	}
@@ -538,7 +524,7 @@ foreach (99..103) {
 
 my $didwarn = 0;
 
-foreach (99..103) {
+foreach (102..102) {
     if ($Problem{$_}) {
 	my @f = sort keys %{ $Problem{$_} };
 	my $f = join(" ", @f);
@@ -567,7 +553,7 @@ if ($didwarn) {
     
     foreach my $l (@Locale) {
 	my $p = 0;
-	foreach my $t (99..103) {
+	foreach my $t (102..102) {
 	    $p++ if $Problem{$t}{$l};
 	}
 	push @s, $l if $p == 0;
@@ -582,4 +568,75 @@ if ($didwarn) {
 	"# tested okay.\n#\n",
 }
 
+{
+    use locale;
+
+    my ($x, $y) = (1.23, 1.23);
+
+    my $a = "$x";
+    printf ''; # printf used to reset locale to "C"
+    my $b = "$y";
+
+    print "not " unless $a eq $b;
+    print "ok 103\n";
+
+    my $c = "$x";
+    my $z = sprintf ''; # sprintf used to reset locale to "C"
+    my $d = "$y";
+
+    print "not " unless $c eq $d;
+    print "ok 104\n";
+
+    my $w = 0;
+    local $SIG{__WARN__} = sub { $w++ };
+    local $^W = 1;
+
+    # the == (among other things) used to warn for locales
+    # that had something else than "." as the radix character
+
+    print "not " unless $c == 1.23;
+    print "ok 105\n";
+
+    print "not " unless $c == $x;
+    print "ok 106\n";
+
+    print "not " unless $c == $d;
+    print "ok 107\n";
+
+    debug "# 103..107: a = $a, b = $b, c = $c, d = $d\n";
+
+    {
+	no locale;
+	
+	my $e = "$x";
+
+	print "not " unless $e == 1.23;
+	print "ok 108\n";
+
+	print "not " unless $e == $x;
+	print "ok 109\n";
+
+	print "not " unless $e == $c;
+	print "ok 110\n";
+
+	debug "# 108..110: e = $e\n";
+    }
+
+    print "not " unless $w == 0;
+    print "ok 111\n";
+
+    my $f = "1.23";
+
+    print "not " unless $f == 1.23;
+    print "ok 112\n";
+
+    print "not " unless $f == $x;
+    print "ok 113\n";
+
+    print "not " unless $f == $c;
+    print "ok 114\n";
+
+    debug "# 112..114: f = $f\n";
+}
+
 # eof
diff --git a/toke.c b/toke.c
index 4b4e140..b025b24 100644
--- a/toke.c
+++ b/toke.c
@@ -6146,9 +6146,8 @@ Perl_scan_num(pTHX_ char *start)
 
 	/* make an sv from the string */
 	sv = NEWSV(92,0);
-	/* reset numeric locale in case we were earlier left in Swaziland */
-	SET_NUMERIC_STANDARD();
-	value = atof(PL_tokenbuf);
+
+	value = Atof(PL_tokenbuf);
 
 	/* 
 	   See if we can make do with an integer value without loss of
diff --git a/util.c b/util.c
index 6755c48..381aece 100644
--- a/util.c
+++ b/util.c
@@ -51,6 +51,10 @@
 #  include <sys/wait.h>
 #endif
 
+#ifdef I_LOCALE
+#  include <locale.h>
+#endif
+
 #define FLUSH
 
 #ifdef LEAKTEST
@@ -536,6 +540,27 @@ Perl_new_collate(pTHX_ const char *newcoll)
 #endif /* USE_LOCALE_COLLATE */
 }
 
+void
+perl_set_numeric_radix(void)
+{
+#ifdef USE_LOCALE_NUMERIC
+# ifdef HAS_LOCALECONV
+    struct lconv* lc;
+
+    lc = localeconv();
+    if (lc && lc->decimal_point)
+	/* We assume that decimal separator aka the radix
+	 * character is always a single character.  If it
+	 * ever is a string, this needs to be rethunk. */
+	PL_numeric_radix = *lc->decimal_point;
+    else
+	PL_numeric_radix = 0;
+# endif /* HAS_LOCALECONV */
+#else
+    PL_numeric_radix = 0;
+#endif /* USE_LOCALE_NUMERIC */
+}
+
 /*
  * Set up for a new numeric locale.
  */
@@ -559,6 +584,7 @@ Perl_new_numeric(pTHX_ const char *newnum)
 	PL_numeric_name = savepv(newnum);
 	PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
 	PL_numeric_local = TRUE;
+	perl_set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
@@ -587,12 +613,12 @@ Perl_set_numeric_local(pTHX)
 	setlocale(LC_NUMERIC, PL_numeric_name);
 	PL_numeric_standard = FALSE;
 	PL_numeric_local = TRUE;
+	perl_set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
 }
 
-
 /*
  * Initialize locale awareness.
  */
@@ -3432,3 +3458,23 @@ Perl_my_fflush_all(pTHX)
     return EOF;
 #endif
 }
+
+double
+Perl_my_atof(const char* s) {
+#ifdef USE_LOCALE_NUMERIC
+    if (PL_numeric_local) {
+	double x, y;
+
+	x = atof(s);
+	SET_NUMERIC_STANDARD();
+	y = atof(s);
+	SET_NUMERIC_LOCAL();
+	if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
+	    return y;
+	return x;
+    } else
+	return atof(s);
+#else
+    return atof(s);
+#endif
+}