From: Hugo van der Sanden Date: Thu, 31 May 2001 20:49:48 +0000 (+0100) Subject: Re: [ID 20010529.006] String plus zero inconsistent across platforms X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1f727ac0e62bc2e40ea8fa3c4c25da4e405d0fba;p=p5sagit%2Fp5-mst-13.2.git Re: [ID 20010529.006] String plus zero inconsistent across platforms Message-Id: <200105311949.UAA02798@crypt.compulink.co.uk> p4raw-id: //depot/perl@10379 --- diff --git a/embed.h b/embed.h index 1a2f0e0..dd0097c 100644 --- a/embed.h +++ b/embed.h @@ -1178,6 +1178,7 @@ #define sv_utf8_upgrade_flags Perl_sv_utf8_upgrade_flags #define sv_pvn_force_flags Perl_sv_pvn_force_flags #define sv_2pv_flags Perl_sv_2pv_flags +#define my_atof2 Perl_my_atof2 #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -2667,6 +2668,7 @@ #define sv_utf8_upgrade_flags(a,b) Perl_sv_utf8_upgrade_flags(aTHX_ a,b) #define sv_pvn_force_flags(a,b,c) Perl_sv_pvn_force_flags(aTHX_ a,b,c) #define sv_2pv_flags(a,b,c) Perl_sv_2pv_flags(aTHX_ a,b,c) +#define my_atof2(a,b) Perl_my_atof2(aTHX_ a,b) #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) @@ -5186,6 +5188,8 @@ #define sv_pvn_force_flags Perl_sv_pvn_force_flags #define Perl_sv_2pv_flags CPerlObj::Perl_sv_2pv_flags #define sv_2pv_flags Perl_sv_2pv_flags +#define Perl_my_atof2 CPerlObj::Perl_my_atof2 +#define my_atof2 Perl_my_atof2 #define Perl_ck_anoncode CPerlObj::Perl_ck_anoncode #define ck_anoncode Perl_ck_anoncode #define Perl_ck_bitop CPerlObj::Perl_ck_bitop diff --git a/embed.pl b/embed.pl index 139270b..7c251bb 100755 --- a/embed.pl +++ b/embed.pl @@ -2594,3 +2594,4 @@ Apd |void |sv_catsv_flags |SV* dsv|SV* ssv|I32 flags Apd |STRLEN |sv_utf8_upgrade_flags|SV *sv|I32 flags Apd |char* |sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags Ap |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags +Ap |char* |my_atof2 |const char *s|NV* value diff --git a/global.sym b/global.sym index 544e1cf..b8bfb2c 100644 --- a/global.sym +++ b/global.sym @@ -579,3 +579,4 @@ Perl_sv_catsv_flags Perl_sv_utf8_upgrade_flags Perl_sv_pvn_force_flags Perl_sv_2pv_flags +Perl_my_atof2 diff --git a/objXSUB.h b/objXSUB.h index a3cb92c..d3ca527 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -2414,6 +2414,10 @@ #define Perl_sv_2pv_flags pPerl->Perl_sv_2pv_flags #undef sv_2pv_flags #define sv_2pv_flags Perl_sv_2pv_flags +#undef Perl_my_atof2 +#define Perl_my_atof2 pPerl->Perl_my_atof2 +#undef my_atof2 +#define my_atof2 Perl_my_atof2 #endif /* PERL_CORE && PERL_OBJECT */ #endif /* __objXSUB_h__ */ diff --git a/perl.h b/perl.h index 88d32a4..4561467 100644 --- a/perl.h +++ b/perl.h @@ -1311,24 +1311,8 @@ typedef NVTYPE NV; # endif #endif -#if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# if !defined(Perl_atof) && defined(HAS_STRTOLD) -# define Perl_atof(s) (NV)strtold(s, (char**)NULL) -# endif -# if !defined(Perl_atof) && defined(HAS_ATOLF) -# define Perl_atof (NV)atolf -# endif -# if !defined(Perl_atof) && defined(PERL_SCNfldbl) -# define Perl_atof PERL_SCNfldbl -# define Perl_atof2(s,f) sscanf((s), "%"PERL_SCNfldbl, &(f)) -# endif -#endif -#if !defined(Perl_atof) -# define Perl_atof atof /* we assume atof being available anywhere */ -#endif -#if !defined(Perl_atof2) -# define Perl_atof2(s,f) ((f) = (NV)Perl_atof(s)) -#endif +#define Perl_atof(s) Perl_my_atof(s) +#define Perl_atof2(s, np) Perl_my_atof2(s, np) /* Previously these definitions used hardcoded figures. * It is hoped these formula are more portable, although diff --git a/perlapi.c b/perlapi.c index b8ec2c5..a04ab22 100644 --- a/perlapi.c +++ b/perlapi.c @@ -4289,6 +4289,13 @@ Perl_sv_2pv_flags(pTHXo_ SV* sv, STRLEN* lp, I32 flags) return ((CPerlObj*)pPerl)->Perl_sv_2pv_flags(sv, lp, flags); } +#undef Perl_my_atof2 +char* +Perl_my_atof2(pTHXo_ const char *s, NV* value) +{ + return ((CPerlObj*)pPerl)->Perl_my_atof2(s, value); +} + #undef Perl_fprintf_nocontext int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) diff --git a/proto.h b/proto.h index 5104261..9a5cdfb 100644 --- a/proto.h +++ b/proto.h @@ -1314,3 +1314,4 @@ PERL_CALLCONV void Perl_sv_catsv_flags(pTHX_ SV* dsv, SV* ssv, I32 flags); PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade_flags(pTHX_ SV *sv, I32 flags); PERL_CALLCONV char* Perl_sv_pvn_force_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags); PERL_CALLCONV char* Perl_sv_2pv_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags); +PERL_CALLCONV char* Perl_my_atof2(pTHX_ const char *s, NV* value); diff --git a/util.c b/util.c index 6a01a46..9b6795b 100644 --- a/util.c +++ b/util.c @@ -4018,21 +4018,88 @@ Perl_my_atof(pTHX_ const char* s) if ((PL_hints & HINT_LOCALE) && PL_numeric_local) { NV y; - Perl_atof2(s, x); + Perl_atof2(s, &x); SET_NUMERIC_STANDARD(); - Perl_atof2(s, y); + Perl_atof2(s, &y); SET_NUMERIC_LOCAL(); if ((y < 0.0 && y < x) || (y > 0.0 && y > x)) return y; } else - Perl_atof2(s, x); + Perl_atof2(s, &x); #else - Perl_atof2(s, x); + Perl_atof2(s, &x); #endif return x; } +char* +Perl_my_atof2(pTHX_ const char* orig, NV* value) +{ + NV result = 0.0; + bool negative = 0; + char* s = (char*)orig; + char* point = "."; /* locale-dependent decimal point equivalent */ + STRLEN pointlen = 1; + bool seendigit = 0; + + if (PL_numeric_radix_sv) + point = SvPV(PL_numeric_radix_sv, pointlen); + + switch (*s) { + case '-': + negative = 1; + /* fall through */ + case '+': + ++s; + } + while (isDIGIT(*s)) { + result = result * 10 + (*s++ - '0'); + seendigit = 1; + } + if (memEQ(s, point, pointlen)) { + NV decimal = 0.1; + + s += pointlen; + while (isDIGIT(*s)) { + result += (*s++ - '0') * decimal; + decimal *= 0.1; + seendigit = 1; + } + } + if (seendigit && (*s == 'e' || *s == 'E')) { + I32 exponent = 0; + I32 expnegative = 0; + I32 bit; + NV power; + + ++s; + switch (*s) { + case '-': + expnegative = 1; + /* fall through */ + case '+': + ++s; + } + while (isDIGIT(*s)) + exponent = exponent * 10 + (*s++ - '0'); + + /* now apply the exponent */ + power = (expnegative) ? 0.1 : 10.0; + for (bit = 1; exponent; bit <<= 1) { + if (exponent & bit) { + exponent ^= bit; + result *= power; + } + power *= power; + } + } + if (negative) + result = -result; + *value = result; + return s; +} + void Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) {