/* numeric.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2005 by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
U32
Perl_cast_ulong(pTHX_ NV f)
{
+ PERL_UNUSED_CONTEXT;
if (f < 0.0)
return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
if (f < U32_MAX_P1) {
I32
Perl_cast_i32(pTHX_ NV f)
{
+ PERL_UNUSED_CONTEXT;
if (f < I32_MAX_P1)
return f < I32_MIN ? I32_MIN : (I32) f;
if (f < U32_MAX_P1) {
IV
Perl_cast_iv(pTHX_ NV f)
{
+ PERL_UNUSED_CONTEXT;
if (f < IV_MAX_P1)
return f < IV_MIN ? IV_MIN : (IV) f;
if (f < UV_MAX_P1) {
UV
Perl_cast_uv(pTHX_ NV f)
{
+ PERL_UNUSED_CONTEXT;
if (f < 0.0)
return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
if (f < UV_MAX_P1) {
return f > 0 ? UV_MAX : 0 /* NaN */;
}
-#if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
-/*
- * This hack is to force load of "huge" support from libm.a
- * So it is in perl for (say) POSIX to use.
- * Needed for SunOS with Sun's 'acc' for example.
- */
-NV
-Perl_huge(void)
-{
-# if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
- return HUGE_VALL;
-# endif
- return HUGE_VAL;
-}
-#endif
-
/*
=for apidoc grok_bin
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
- const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
char bit;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
- const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
- const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
for (; len-- && *s; s++) {
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
- const char* radix = SvPV(PL_numeric_radix_sv, len);
+ const char * const radix = SvPV(PL_numeric_radix_sv, len);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
- const char *send = pv + len;
+ const char * const send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
if (exponent == 0)
return value;
if (value == 0)
- return 0;
+ return (NV)0;
/* On OpenVMS VAX we by default use the D_FLOAT double format,
* and that format does not have *easy* capabilities [1] for
#if ((defined(VMS) && !defined(__IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
STMT_START {
- NV exp_v = log10(value);
+ const NV exp_v = log10(value);
if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
return NV_MAX;
if (exponent < 0) {
{
NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (PL_numeric_local && IN_LOCALE) {
NV y;
++s;
}
+ /* punt to strtod for NaN/Inf; if no support for it there, tough luck */
+
+#ifdef HAS_STRTOD
+ if (*s == 'n' || *s == 'N' || *s == 'i' || *s == 'I') {
+ const char *p = negative ? s - 1 : s;
+ char *endp;
+ NV rslt;
+ rslt = strtod(p, &endp);
+ if (endp != p) {
+ *value = rslt;
+ return (char *)endp;
+ }
+ }
+#endif
+
/* we accumulate digits into an integer; when this becomes too
* large, we add the total to NV and start again */