String plus zero inconsistent across platforms #4046
Comments
From [email protected]This is a bug report for perl from kpt3@twicom.com, The following line is inconsistent across different platforms: print "0x1" + 0 . "\n"; Perl on Linux (v5.6.0) gives 1 The Linux Perl came with RedHat 7.1 This seems to me to be a rather fundemental problem. Kevin Twidle Flags: Site configuration information for perl v5.6.1: Configured by Fifer at Thu Dec 21 21:37:10 2000. Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration: Locally applied patches: @INC for perl v5.6.1: Environment for perl v5.6.1: |
From @rspierThis appears to be a system-specific problem with whatever is used to Some of the systems _do_ parse 0x1 as 1, others parse it as 0. The bad conversion (in this example) happens at Line 1822 in sv.c I seem to remember some discussion for the inclusion of a standard -R p.s. Jarrko- What do you think about including the mod_perl .gdbinit Linux FreeBSD 5.6.0 Windows (AS 623) Solaris: Irix: Kevin Twidle writes:
|
From @jhiHmmm... I really, really vaguely remember seeing this portability bug
Yup.
s/rrk/rkk/
Sure. How uptodate it is? |
From @jhiHo-hum. It's even more fun than that. Linux/x86 perl-current: papaija:/tmp/jhi/perl ; ./perl -wle 'print "0x1" + "0x0"' So far, so good... now it gets interesting. papaija:/tmp/jhi/perl ; ./perl -wle 'print "0x1" + "0x2"' |
From [Unknown Contact. See original ticket]GNU Libc's stdlib.h defines strtold (and strtod) thus: extern __inline long double For some reason, strtold does not take a "base" parameter, unlike, say, (The 0 argument to __strtold_internal above indicates whether or not to
Similar interesting behaviour is displayed by any hexadecimal number in Is anyone working on an strtold replacement for the core? - ams |
From @rspierLooks decently up to date. It could bear some expansion, but it's a I removed some mod_perl specific stuff, but that wasn't much. Here's a file-creation patch. Inline Patch--- /dev/null Fri Mar 23 23:37:44 2001
+++ Porting/gdbmacros Wed May 30 11:26:27 2001
@@ -0,0 +1,190 @@
+#
+# GDB debugging macros file
+# (thanks to the mod_perl team for developing this.)
+#
+# either copy this file to .gdbinit in the directory you are running
+# the gdb from, or at the gdb prompt:
+# (gdb) source path-to-perl-source/Porting/gdbmacros
+#
+#some handy debugging macros, hopefully you'll never need them
+#some don't quite work, like dump_hv and hv_fetch,
+#where's the bloody manpage for .gdbinit syntax?
+
+define STpvx
+ print ((XPV*) (PL_stack_base [ax + ($arg0)] )->sv_any )->xpv_pv
+end
+
+define TOPs
+ print ((XPV*) (**sp)->sv_any )->xpv_pv
+end
+
+define curstash
+ print ((XPVHV*) (PL_curstash)->sv_any)->xhv_name
+end
+
+define defstash
+ print ((XPVHV*) (PL_defstash)->sv_any)->xhv_name
+end
+
+define curinfo
+ printf "%d:%s\n", PL_curcop->cop_line, \
+ ((XPV*)(*(XPVGV*)PL_curcop->cop_filegv->sv_any)\
+ ->xgv_gp->gp_sv->sv_any)->xpv_pv
+end
+
+define SvPVX
+print ((XPV*) ($arg0)->sv_any )->xpv_pv
+end
+
+define SvCUR
+ print ((XPV*) ($arg0)->sv_any )->xpv_cur
+end
+
+define SvLEN
+ print ((XPV*) ($arg0)->sv_any )->xpv_len
+end
+
+define SvEND
+ print (((XPV*) ($arg0)->sv_any )->xpv_pv + ((XPV*)($arg0)->sv_any )->xpv_cur) - 1
+end
+
+define SvSTASH
+ print ((XPVHV*)((XPVMG*)($arg0)->sv_any )->xmg_stash)->sv_any->xhv_name
+end
+
+define SvTAINTED
+ print ((($arg0)->sv_flags & (0x00002000 |0x00004000 |0x00008000 )) && Perl_sv_tainted ($arg0))
+end
+
+define SvTRUE
+ print ( !$arg0 ? 0 : (($arg0)->sv_flags & 0x00040000 ) ? ((PL_Xpv = (XPV*)($arg0)->sv_any ) && (*PL_Xpv ->xpv_pv > '0' || PL_Xpv ->xpv_cur > 1 || (PL_Xpv ->xpv_cur && *PL_Xpv ->xpv_pv != '0')) ? 1 : 0) : (($arg0)->sv_flags & 0x00010000 ) ? ((XPVIV*) ($arg0)->sv_any )->xiv_iv != 0 : (($arg0)->sv_flags & 0x00020000 ) ? ((XPVNV*)($arg0)->sv_any )->xnv_nv != 0.0 : Perl_sv_2bool ($arg0) )
+end
+
+define GvHV
+ set $hv = (((((XPVGV*)($arg0)->sv_any ) ->xgv_gp) )->gp_hv)
+end
+
+define GvSV
+ print ((XPV*) ((((XPVGV*)($arg0)->sv_any ) ->xgv_gp) ->gp_sv )->sv_any )->xpv_pv
+end
+
+define GvNAME
+ print (((XPVGV*)($arg0)->sv_any ) ->xgv_name)
+end
+
+define GvFILEGV
+ print ((XPV*) ((((XPVGV*)$arg0->filegv)->xgv_gp)->gp_sv)->sv_any)->xpv_pv
+end
+
+define CvNAME
+ print ((XPVGV*)(((XPVCV*)($arg0)->sv_any)->xcv_gv)->sv_any)->xgv_name
+end
+
+define CvSTASH
+ print ((XPVHV*)(((XPVGV*)(((XPVCV*)($arg0)->sv_any)->xcv_gv)->sv_any)->xgv_stash)->sv_any)->xhv_name
+end
+
+define CvDEPTH
+ print ((XPVCV*)($arg0)->sv_any )->xcv_depth
+end
+
+define CvFILEGV
+ print ((XPV*) ((((XPVGV*)((XPVCV*)($arg0)->sv_any )->xcv_filegv)->xgv_gp)->gp_sv)->sv_any)->xpv_pv
+end
+
+define SVOPpvx
+ print ((XPV*) ( ((SVOP*)$arg0)->op_sv)->sv_any )->xpv_pv
+end
+
+define HvNAME
+ print ((XPVHV*)$arg0->sv_any)->xhv_name
+end
+
+define HvKEYS
+ print ((XPVHV*) ($arg0)->sv_any)->xhv_keys
+end
+
+define AvFILL
+ print ((XPVAV*) ($arg0)->sv_any)->xav_fill
+end
+
+define dumpav
+ set $n = ((XPVAV*) ($arg0)->sv_any)->xav_fill
+ set $i = 0
+ while $i <= $n
+ set $sv = *Perl_av_fetch($arg0, $i, 0)
+ printf "[%u] -> `%s'\n", $i, ((XPV*) ($sv)->sv_any )->xpv_pv
+ set $i = $i + 1
+ end
+end
+
+define dumphv
+ set $n = ((XPVHV*) ($arg0)->sv_any)->xhv_keys
+ set $i = 0
+ set $key = 0
+ set $klen = 0
+ Perl_hv_iterinit($arg0)
+ while $i <= $n
+ set $sv = Perl_hv_iternextsv($arg0, &$key, &$klen)
+ printf "%s = `%s'\n", $key, ((XPV*) ($sv)->sv_any )->xpv_pv
+ set $i = $i + 1
+ end
+end
+
+define hvfetch
+ set $klen = strlen($arg1)
+ set $sv = *Perl_hv_fetch($arg0, $arg1, $klen, 0)
+ printf "%s = `%s'\n", $arg1, ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define hvINCval
+ set $hv = (((((XPVGV*)(PL_incgv)->sv_any)->xgv_gp))->gp_hv)
+ set $klen = strlen($arg0)
+ set $sv = *Perl_hv_fetch($hv, $arg0, $klen, 0)
+ printf "%s = `%s'\n", $arg0, ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define dumpany
+ set $sv = Perl_newSVpv("use Data::Dumper; Dumper \\",0)
+ set $void = Perl_sv_catpv($sv, $arg0)
+ set $dump = perl_eval_pv(((XPV*) ($sv)->sv_any )->xpv_pv, 1)
+ printf "%s = `%s'\n", $arg0, ((XPV*) ($dump)->sv_any )->xpv_pv
+end
+
+define dumpanyrv
+ set $rv = Perl_newRV((SV*)$arg0)
+ set $rvpv = perl_get_sv("main::DumpAnyRv", 1)
+ set $void = Perl_sv_setsv($rvpv, $rv)
+ set $sv = perl_eval_pv("use Data::Dumper; Dumper $::DumpAnyRv",1)
+ printf "`%s'\n", ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define svpeek
+ set $pv = Perl_sv_peek((SV*)$arg0)
+ printf "%s\n", $pv
+end
+
+define caller
+ set $sv = perl_eval_pv("scalar caller", 1)
+ printf "caller = %s\n", ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define cluck
+ set $sv = perl_eval_pv("Carp::cluck(); `tail '$Apache::ErrLog'`", 1)
+ printf "%s\n", ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define longmess
+ set $sv = perl_eval_pv("Carp::longmess()", 1)
+ printf "%s\n", ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define shortmess
+ set $sv = perl_eval_pv("Carp::shortmess()", 1)
+ printf "%s\n", ((XPV*) ($sv)->sv_any )->xpv_pv
+end
+
+define perl_get_sv
+ set $sv = perl_get_sv($arg0, 0)
+ printf "%s\n", $sv ? ((XPV*) ((SV*)$sv)->sv_any)->xpv_pv : "undef"
+end |
From [Unknown Contact. See original ticket]
as i mentioned in my reply to simon's original message, many of the macros From dougm@covalent.net Wed Apr 18 09:32:22 2001 -0700 On Wed, 18 Apr 2001, Simon Cozens wrote:
most of them were originally generated by Devel::DebugInit, some crafted |
From [Unknown Contact. See original ticket]String Binary Binary fraction Decimal fraction Perl is taking the second number as a binary fraction with a fixed decimal I cannot test it because trying Linux (5.6.0) gives Cygwin(5.6.1) gives Kevin ----- Original Message -----
|
From @jhi==== //depot/perl/sv.c#402 - /u/vieraat/vieraat/jhi/pp4/perl/sv.c ==== Inline Patch--- perl/sv.c.~1~ Thu May 31 05:04:49 2001
+++ perl/sv.c Thu May 31 05:04:49 2001
@@ -1871,6 +1871,8 @@
#endif
{
NV d;
+ char *s;
+ bool firstzero;
#ifdef HAS_STRTOL
/* Hopefully trace flow will optimise this away where possible
*/
@@ -1878,7 +1880,15 @@
#endif
/* It wasn't an integer, or it overflowed, or we don't have
strtol. Do things the slow way - check if it's a UV etc. */
- d = Atof(SvPVX(sv));
+ s = SvPVX(sv);
+ firstzero = s[0] == '0';
+ d =
+ (firstzero && toLOWER(s[1]) == 'x') ?
+ (NV)Strtoul(s + 2, 0, 16) :
+ (firstzero && toLOWER(s[1]) == 'b' ?
+ (NV)Strtoul(s + 2, 0, 2) :
+ (firstzero && s[1] >= '0' && s[1] <= '7' ?
+ (NV)Strtoul(s + 1, 0, 8) : Atof(s)));
if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
@@ -2326,7 +2336,9 @@
#endif
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
+ int numtype = looks_like_number(sv);
+
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
not_a_number(sv);
SvNVX(sv) = Atof(SvPVX(sv));
#ifdef NV_PRESERVES_UV
@@ -2348,7 +2360,6 @@
} else {
/* Is it something we can run through strtol etc (ie no
trailing exponent part)? */
- int numtype = looks_like_number(sv);
/* XXX probably should cache this if called above */
if (!(numtype &
End of Patch. |
From @vanstynI don't think we do: for a long time we have taught people that "37xa" Hugo |
From @jhiWell, in that case we must go in the other direction and stop some
|
From @vanstynAttached is a start, which passes all but pragma/locale.t here. I think I'd suggest also that Perl_atof2 be redefined - it is confusing having This patch requires a 'make regen_headers'. Hugo Inline Patch--- embed.pl.old Sun May 27 00:32:32 2001
+++ embed.pl Thu May 31 15:28:58 2001
@@ -2592,3 +2592,4 @@
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
--- perl.h.old Thu May 31 02:17:32 2001
+++ perl.h Thu May 31 15:34:23 2001
@@ -1311,24 +1311,8 @@
# 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
--- util.c.old Thu May 31 13:43:03 2001
+++ util.c Thu May 31 15:50:57 2001
@@ -4033,6 +4033,63 @@
return x;
}
+char*
+Perl_my_atof2(pTHX_ const char* orig, NV* value)
+{
+ NV result = 0.0;
+ bool negative = 0;
+ char* s = (char*)orig;
+
+ switch (*s) {
+ case '-':
+ negative = 1;
+ /* fall through */
+ case '+':
+ ++s;
+ }
+ while (isDIGIT(*s))
+ result = result * 10 + (*s++ - '0');
+ if (*s == '.') {
+ NV decimal = 1.0;
+ ++s;
+ while (isDIGIT(*s)) {
+ decimal /= 10;
+ result += (*s++ - '0') * decimal;
+ }
+ }
+ if (*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)
{ |
From @simoncozensDo we actually want this? It'd slow numeric conversion down horribly, and |
From @vanstynI assume we need a mechanism capable of parsing a number out of a unicode Hugo |
From @rspierI agree with Hugo, but the portability problem remains. Might something that does something similar to: sub Atof { be a happy solution? -R |
From @simoncozensI'm reasonably sure the code in your patch was Unicode-happy. I'll have to |
From @nwc10I like that idea better.
There wasn't a test for 1 + 1 == 2 until recently.
Do we really want to do this? Nicholas Clark |
From @vanstynAttached is a continuation, which passes all current tests here. :I think it needs the following changes: Not done; I don't know what is needed here. :- locale support Done, I think - we have support for locale 'decimal_point', but not :- ? unicode support I think this is only a problem if a) the locale-specific decimal point :- inf/nan support Not done, I don't know what is needed here. :- (optional) rewrite 'apply the exponent' to be faster The current algorithm is acceptable but not fast: we do one fp multiply :- add tests: it is surprising that only locale of the above missing features I think we need tests for bad numbers like "+23E" and "+E23" for example. :I'd suggest also that Perl_atof2 be redefined - it is confusing having Done this. :This patch requires a 'make regen_headers'. This patch replaces the last one, and still requires a 'make regen_headers'. Hugo Inline Patch--- embed.pl.old Sun May 27 00:32:32 2001
+++ embed.pl Thu May 31 15:28:58 2001
@@ -2592,3 +2592,4 @@
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
--- perl.h.old Thu May 31 02:17:32 2001
+++ perl.h Thu May 31 20:23:23 2001
@@ -1311,24 +1311,8 @@
# 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
--- util.c.old Thu May 31 13:43:03 2001
+++ util.c Thu May 31 20:43:29 2001
@@ -4018,19 +4018,86 @@
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 |
From @vanstynI think so, but it's always possible that we don't want to do it in :IIRC Nick I-S recently posted the descriptions of 2 papers here, about how There are several obvious pitfalls, which I'm hoping someone else will To be honest, I think we should ignore underflow - if the user gets zero, I guess there's also some potential for accumulating error because we I hope that the patch will be applied, and that we'll then get some Hugo |
From @jhiYup. It's one Unicode character but two bytes.
|
From @jhiDo you mean if (seendigit && (*s == 'e' || *s == 'E')) { If so, the -Wall is good for something :-) |
From @jhiAssuming that the separator is only one byte is wrong. |
From @jhiThe patch applied now, however. |
From @vanstynYes. :If so, the -Wall is good for something :-) Yes. Hugo |
From @vanstynI don't, do I? :See util.c:Perl_set_numeric_radix(). I did: point = SvPV(PL_numeric_radix_sv, pointlen); Hugo |
From @jhiThat's good, then.
|
From @jhiHmmm. This patch has a strange effect: the posix.t #14 (strtod) |
From @vanstynI think you need to dump not $n but the literal; try something like: Hugo |
From @jhiInline Patch--- t/lib/posix.t Sat Jun 2 20:11:44 2001
+++ p.t Sat Jun 2 22:29:40 2001
@@ -79,6 +79,9 @@
if ($Config{d_strtod}) {
$lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
($n, $x) = &POSIX::strtod('3.14159_OR_SO');
+ use Devel::Peek;
+ $pi = 3.14159;
+ Dump($pi); Dump($n); Dump($x);
# Using long double NVs may introduce greater accuracy than wanted.
$n =~ s/^3.14158999\d*$/3.14159/
if $Config{uselongdouble} eq 'define';
This on the solaris/sparc/gcc. akvavitix:/tmp/jhi/perl ; ./perl -Ilib -MPOSIX=strtod -MDevel::Peek -wle '$n=strtod("3.14159");Dump($n);print "ok" if $n == 3.14159;print $n - 3.14159' With 5.6.0 (don't have 5.6.1 compiled): akvavitix:/tmp/jhi/perl ; /p/bin/perl -MPOSIX=strtod -MDevel::Peek -wle '$n=strtod("3.14159");Dump($n);print "ok" if $n == 3.14159;print $n - 3.14159' |
From @jhiAlso an interesting question is why POSIX::strtod()? |
From @vanstynPresumably, because that is what's doing the same thing more Hugo |
From @vanstynCould you show, say, a %.32f of $n and of 3.14159 please? Hugo |
From @vanstynFor example, this is what I get here: Hugo |
From @vanstynOk, I've now built with -Duselongdouble, and I have this: .. which suggests to me that the tests are failing because the new routine Hugo |
From @jhiakvavitix:/tmp/jhi/perl ; ./perl -Ilib -MPOSIX=strtod -MDevel::Peek -wle '$n=strtod("3.14159");Dump($n);printf "%.32f\n", $n;printf "%.32f\n", 3.14159' akvavitix:/tmp/jhi/perl ;
|
From @vanstynNot sure which config that is, but I'm a little surprised that's so far Hugo |
From @vanstynThird attempt; this passes all tests here with i64 + ld, and I'm I believe gcc gives me a 64-bit mantisssa for long doubles; I'd be Hugo Inline Patch--- util.c.old Thu May 31 20:43:29 2001
+++ util.c.new Sun Jun 3 14:49:25 2001
@@ -4033,6 +4033,35 @@
return x;
}
+NV
+S_mulexp10(NV value, I32 exponent)
+{
+ NV result = value;
+ NV power = 10.0;
+ I32 bit;
+
+ if (exponent > 0) {
+ for (bit = 1; exponent; bit <<= 1) {
+ if (exponent & bit) {
+ exponent ^= bit;
+ result *= power;
+ }
+ power *= power;
+ }
+ }
+ else if (exponent < 0) {
+ exponent = -exponent;
+ for (bit = 1; exponent; bit <<= 1) {
+ if (exponent & bit) {
+ exponent ^= bit;
+ result /= power;
+ }
+ power *= power;
+ }
+ }
+ return result;
+}
+
char*
Perl_my_atof2(pTHX_ const char* orig, NV* value)
{
@@ -4042,10 +4071,26 @@
char* point = "."; /* locale-dependent decimal point equivalent */
STRLEN pointlen = 1;
bool seendigit = 0;
+ I32 expextra = 0;
+ I32 exponent = 0;
+ I32 i;
+/* this is arbitrary */
+#define PARTLIM 6
+/* we want the largest integers we can usefully use */
+#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
+# define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
+ U64 part[PARTLIM];
+#else
+# define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
+ U32 part[PARTLIM];
+#endif
+ I32 ipart = 0; /* index into part[] */
+ I32 offcount; /* number of digits in least significant part */
if (PL_numeric_radix_sv)
point = SvPV(PL_numeric_radix_sv, pointlen);
+ /* sign */
switch (*s) {
case '-':
negative = 1;
@@ -4053,23 +4098,77 @@
case '+':
++s;
}
+
+ part[0] = offcount = 0;
+ if (isDIGIT(*s)) {
+ seendigit = 1; /* get this over with */
+
+ /* skip leading zeros */
+ while (*s == '0')
+ ++s;
+ }
+
+ /* integer digits */
while (isDIGIT(*s)) {
- result = result * 10 + (*s++ - '0');
- seendigit = 1;
+ if (++offcount > PARTSIZE) {
+ if (++ipart < PARTLIM) {
+ part[ipart] = 0;
+ offcount = 1; /* ++0 */
+ }
+ else {
+ /* limits of precision reached */
+ --ipart;
+ --offcount;
+ if (*s >= '5')
+ ++part[ipart];
+ while (isDIGIT(*s)) {
+ ++expextra;
+ ++s;
+ }
+ /* warn of loss of precision? */
+ break;
+ }
+ }
+ part[ipart] = part[ipart] * 10 + (*s++ - '0');
}
- if (memEQ(s, point, pointlen)) {
- NV decimal = 0.1;
+ /* decimal point */
+ if (memEQ(s, point, pointlen)) {
s += pointlen;
+ if (isDIGIT(*s))
+ seendigit = 1; /* get this over with */
+
+ /* decimal digits */
while (isDIGIT(*s)) {
- result += (*s++ - '0') * decimal;
- decimal *= 0.1;
- seendigit = 1;
+ if (++offcount > PARTSIZE) {
+ if (++ipart < PARTLIM) {
+ part[ipart] = 0;
+ offcount = 1; /* ++0 */
+ }
+ else {
+ /* limits of precision reached */
+ --ipart;
+ --offcount;
+ if (*s >= '5')
+ ++part[ipart];
+ while (isDIGIT(*s))
+ ++s;
+ /* warn of loss of precision? */
+ break;
+ }
+ }
+ --expextra;
+ part[ipart] = part[ipart] * 10 + (*s++ - '0');
}
}
+
+ /* combine components of mantissa */
+ for (i = 0; i <= ipart; ++i)
+ result += S_mulexp10((NV)part[ipart - i],
+ i ? offcount + (i - 1) * PARTSIZE : 0);
+
if (seendigit && *s == 'e' || *s == 'E') {
- I32 exponent = 0;
- I32 expnegative = 0;
+ bool expnegative = 0;
I32 bit;
NV power;
@@ -4083,17 +4182,15 @@
}
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 (expnegative)
+ exponent = -exponent;
}
+
+ /* now apply the exponent */
+ exponent += expextra;
+ result = S_mulexp10(result, exponent);
+
+ /* now apply the sign */
if (negative)
result = -result;
*value = result; |
From @vanstyni32 + ld (which I've never tried before) gives me one test failure, Nick, could this be related to your numeric conversion work? Hugo |
From @nwc10Not directly. It looks like ID 20010118.017, which Abigail found was failing Quote Abigail from <20010119203420.828.qmail@foad.org>: Same errors with the released 5.7.0. $ ./perl -I../lib ~abigail/Src/perl/t/op/int.t So it seems that you are able to re-create bug 20010118.017. I wasn't. Nicholas Clark |
From @jhiAt the moment I'm not using -ld at all.
|
From @vanstynOk, I'll try to come back to this one later. Hugo |
From @vanstynWhoops: I forgot to add the parens here. Hugo |
From @jhiEven with the above, the "3rd try", and the handy.h patch I still akvavitix:/tmp/jhi/perl ; ./perl -Ilib -MPOSIX=strtod -MDevel::Peek -wle '$n=strtod("3.14159");Dump($n);printf "%.32f\n", $n;printf "%.32f\n", 3.14159' and the t/lib/posix.t #14 failing. I'm not using long doubles.
|
From @jhiChange 10408 by jhi@alpha on 2001/06/03 16:52:41 Tweak the test to be happy if the accuracy is 'good enough'. Affected files ... ... //depot/perl/t/lib/posix.t#20 edit Differences ... ==== //depot/perl/t/lib/posix.t#20 (xtext) ==== Inline Patch--- perl/t/lib/posix.t.~1~ Sun Jun 3 20:52:46 2001
+++ perl/t/lib/posix.t Sun Jun 3 20:52:46 2001
@@ -82,7 +82,8 @@
# Using long double NVs may introduce greater accuracy than wanted.
$n =~ s/^3.1415(8999|9000)\d*$/3.14159/
if $Config{uselongdouble} eq 'define';
- print (($n == 3.14159) && ($x == 6) ? "ok 14\n" : "not ok 14\n");
+ print ((abs($n - 3.14159) < 0.00001) && ($x == 6) ?
+ "ok 14\n" : "not ok 14\n");
&POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
} else { print "# strtod not present\n", "ok 14\n"; }
End of Patch. |
From [Unknown Contact. See original ticket]...
Is there progress being made on this issue? I've noticed that the patch hasn't been applied yet. |
From @vanstynOk, I think this is happening because we calculate 314159/10/10000. Hugo Inline Patch--- util.c.old Mon Jun 4 00:46:14 2001
+++ util.c Tue Jun 5 12:51:11 2001
@@ -4036,30 +4036,25 @@
NV
S_mulexp10(NV value, I32 exponent)
{
- NV result = value;
+ NV result = 1.0;
NV power = 10.0;
+ bool negative = 0;
I32 bit;
- if (exponent > 0) {
- for (bit = 1; exponent; bit <<= 1) {
- if (exponent & bit) {
- exponent ^= bit;
- result *= power;
- }
- power *= power;
- }
- }
+ if (exponent == 0)
+ return value;
else if (exponent < 0) {
+ negative = 1;
exponent = -exponent;
- for (bit = 1; exponent; bit <<= 1) {
- if (exponent & bit) {
- exponent ^= bit;
- result /= power;
- }
- power *= power;
+ }
+ for (bit = 1; exponent; bit <<= 1) {
+ if (exponent & bit) {
+ exponent ^= bit;
+ result *= power;
}
+ power *= power;
}
- return result;
+ return negative ? value / result : value * result;
}
char* |
From @jhiDoug MacEachern had issues with the proposed macros. |
From @rspierInline Patch--- pod/perltodo.pod.orig Thu Sep 20 22:29:06 2001
+++ pod/perltodo.pod Thu Sep 20 22:42:50 2001
@@ -824,4 +824,16 @@
Collation? http://www.unicode.org/unicode/reports/tr10/
Normalization? http://www.unicode.org/unicode/reports/tr15/
+=head2 Create debugging macros
+
+Debugging macros (like printsv, dump) can make debugging perl inside a
+C debugger much easier. A good set for gdb comes with mod_perl.
+Something similar should be distributed with perl.
+
+The proper way to do this is to use and extend Devel::DebugInit.
+Devel::DebugInit also needs to be extended to support threads.
+
+See p5p archives for late May/early June 2001 for a recent discussion
+on this topic.
+
=cut |
From @jhiThanks, applied.
|
Migrated from rt.perl.org#7059 (status was 'resolved')
Searchable as RT7059$
The text was updated successfully, but these errors were encountered: