Skip to content

Commit

Permalink
PATCH: [perl #41202] text->float gives wrong answer
Browse files Browse the repository at this point in the history
This changes to use Perl_strtod() when available, and that turns out to
be the key to fixing this bug.

S_mulexp10() is removed from embed.fnc to avoid repeating the
complicated prerequisites for defining Perl_strtod().  This works
because this static function already was defined before use in
numeric.c, and always called in full form without using a macro.

James Keenan fixed a file permissions problem originally introduced by
this commit, but the fix has been squashed into it.
  • Loading branch information
sisyphus authored and khwilliamson committed Aug 9, 2018
1 parent c7ea9f0 commit ce6f496
Show file tree
Hide file tree
Showing 4 changed files with 8 additions and 24 deletions.
6 changes: 0 additions & 6 deletions embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -2879,12 +2879,6 @@ pn |Malloc_t |mem_log_realloc |const UV n|const UV typesize|NN const char *type_
pn |Malloc_t |mem_log_free |Malloc_t oldalloc|NN const char *filename|const int linenumber|NN const char *funcname
#endif

#if defined(PERL_IN_NUMERIC_C)
#ifndef USE_QUADMATH
sn |NV|mulexp10 |NV value|I32 exponent
#endif
#endif

#if defined(PERL_IN_UTF8_C)
sR |HV * |new_msg_hv |NN const char * const message \
|U32 categories \
Expand Down
5 changes: 0 additions & 5 deletions embed.h
Original file line number Diff line number Diff line change
Expand Up @@ -1653,11 +1653,6 @@
#define utf16_textfilter(a,b,c) S_utf16_textfilter(aTHX_ a,b,c)
# endif
# endif
# if !defined(USE_QUADMATH)
# if defined(PERL_IN_NUMERIC_C)
#define mulexp10 S_mulexp10
# endif
# endif
# if !defined(UV_IS_QUAD)
# if defined(PERL_IN_UTF8_C)
#define is_utf8_cp_above_31_bits S_is_utf8_cp_above_31_bits
Expand Down
16 changes: 8 additions & 8 deletions numeric.c
Original file line number Diff line number Diff line change
Expand Up @@ -1145,7 +1145,7 @@ Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
return TRUE;
}

#ifndef USE_QUADMATH
#ifndef Perl_strtod
STATIC NV
S_mulexp10(NV value, I32 exponent)
{
Expand Down Expand Up @@ -1241,9 +1241,9 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
#endif /* #ifndef USE_QUADMATH */
#endif /* #ifndef Perl_strtod */

#ifdef USE_QUADMATH
#ifdef Perl_strtod
# define ATOF(s, x) my_atof2(s, &x)
# else
# define ATOF(s, x) Perl_atof2(s, x)
Expand Down Expand Up @@ -1406,13 +1406,13 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
{
const char* s = orig;
NV result[3] = {0.0, 0.0, 0.0};
#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
const char* send = s + ((len != 0)
? len
: strlen(orig)); /* one past the last */
bool negative = 0;
#endif
#if defined(USE_PERL_ATOF) && !defined(USE_QUADMATH)
#if defined(USE_PERL_ATOF) && !defined(Perl_strtod)
UV accumulator[2] = {0,0}; /* before/after dp */
bool seen_digit = 0;
I32 exp_adjust[2] = {0,0};
Expand All @@ -1425,7 +1425,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
I32 sig_digits = 0; /* noof significant digits seen so far */
#endif

#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
PERL_ARGS_ASSERT_MY_ATOF3;

/* leading whitespace */
Expand All @@ -1442,7 +1442,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
}
#endif

#ifdef USE_QUADMATH
#ifdef Perl_strtod
{
char* endp;
char* copy = NULL;
Expand All @@ -1460,7 +1460,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
s = copy + (s - orig);
}

result[2] = strtoflt128(s, &endp);
result[2] = Perl_strtod(s, &endp);

/* If we created a copy, 'endp' is in terms of that. Convert back to
* the original */
Expand Down
5 changes: 0 additions & 5 deletions proto.h
Original file line number Diff line number Diff line change
Expand Up @@ -4324,11 +4324,6 @@ STATIC void S_validate_suid(pTHX_ PerlIO *rsfp);
assert(rsfp)
# endif
#endif
#if !defined(USE_QUADMATH)
# if defined(PERL_IN_NUMERIC_C)
STATIC NV S_mulexp10(NV value, I32 exponent);
# endif
#endif
#if !defined(UV_IS_QUAD)
# if defined(PERL_IN_UTF8_C)
STATIC int S_is_utf8_cp_above_31_bits(const U8 * const s, const U8 * const e, const bool consider_overlongs)
Expand Down

0 comments on commit ce6f496

Please sign in to comment.