sscanf() may be the only way to read long doubles from strings.

p4raw-id: //depot/perl@6937

diff --git a/Configure b/Configure
index 4f8f3cb..43b8061 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Wed Aug 30 16:44:38 EET DST 2000 [metaconfig 3.0 PL70]
+# Generated on Thu Aug 31 07:18:29 EET DST 2000 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >/tmp/c1$$ <<EOF
@@ -735,12 +735,14 @@ d_PRIGldbl=''
 d_PRIeldbl=''
 d_PRIfldbl=''
 d_PRIgldbl=''
+d_SCNfldbl=''
 sPRIEldbl=''
 sPRIFldbl=''
 sPRIGldbl=''
 sPRIeldbl=''
 sPRIfldbl=''
 sPRIgldbl=''
+sSCNfldbl=''
 lseeksize=''
 lseektype=''
 make_set_make=''
@@ -7710,6 +7712,8 @@ fi
 
 if $test X"$sPRIfldbl" = X; then
        echo "Cannot figure out how to print long doubles." >&4
+else
+       sSCNfldbl=$sPRIfldbl    # expect consistency
 fi
 
 $rm -f try try.*
@@ -7719,9 +7723,11 @@ fi # d_longdbl
 case "$sPRIfldbl" in
 '')    d_PRIfldbl="$undef"; d_PRIgldbl="$undef"; d_PRIeldbl="$undef"; 
        d_PRIFldbl="$undef"; d_PRIGldbl="$undef"; d_PRIEldbl="$undef"; 
+       d_SCNfldbl="$undef";
        ;;
 *)     d_PRIfldbl="$define"; d_PRIgldbl="$define"; d_PRIeldbl="$define"; 
        d_PRIFldbl="$define"; d_PRIGldbl="$define"; d_PRIEldbl="$define"; 
+       d_SCNfldbl="$define";
        ;;
 esac
 
@@ -15450,6 +15456,7 @@ d_PRIi64='$d_PRIi64'
 d_PRIo64='$d_PRIo64'
 d_PRIu64='$d_PRIu64'
 d_PRIx64='$d_PRIx64'
+d_SCNfldbl='$d_SCNfldbl'
 d_access='$d_access'
 d_accessx='$d_accessx'
 d_alarm='$d_alarm'
@@ -16026,6 +16033,7 @@ sPRIi64='$sPRIi64'
 sPRIo64='$sPRIo64'
 sPRIu64='$sPRIu64'
 sPRIx64='$sPRIx64'
+sSCNfldbl='$sSCNfldbl'
 sched_yield='$sched_yield'
 scriptdir='$scriptdir'
 scriptdirexp='$scriptdirexp'

diff --git a/config_h.SH b/config_h.SH
index da25617..7c70ab3 100644 (file)
--- a/config_h.SH
+++ b/config_h.SH
@@ -2552,9 +2552,14 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *     This symbol, if defined, contains the string used by stdio to
  *     format long doubles (format 'e') for output.
  */
+/* PERL_SCNfldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'f') for input.
+ */
 #$d_PRIfldbl PERL_PRIfldbl     $sPRIfldbl      /**/
 #$d_PRIgldbl PERL_PRIgldbl     $sPRIgldbl      /**/
 #$d_PRIeldbl PERL_PRIeldbl     $sPRIeldbl      /**/
+#$d_SCNfldbl PERL_SCNfldbl     $sSCNfldbl      /**/
 
 /* Off_t:
  *     This symbol holds the type used to declare offsets in the kernel.

diff --git a/perl.h b/perl.h
index 115e878..6840650 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1220,15 +1220,22 @@ typedef NVTYPE NV;
 
 #if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 #   if !defined(Perl_atof) && defined(HAS_STRTOLD) 
-#       define Perl_atof(s) strtold(s, (char**)NULL)
+#       define Perl_atof(s) (NV)strtold(s, (char**)NULL)
 #   endif
 #   if !defined(Perl_atof) && defined(HAS_ATOLF)
-#       define Perl_atof 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
 
 /* Previously these definitions used hardcoded figures. 
  * It is hoped these formula are more portable, although

diff --git a/util.c b/util.c
index 16f3e02..ea0778f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3875,23 +3875,24 @@ Perl_my_fflush_all(pTHX)
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
+    NV x = 0.0;
 #ifdef USE_LOCALE_NUMERIC
     if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
-       NV x, y;
+       NV y;
 
-       x = Perl_atof(s);
+       Perl_atof2(s, x);
        SET_NUMERIC_STANDARD();
-       y = Perl_atof(s);
+       Perl_atof2(s, y);
        SET_NUMERIC_LOCAL();
        if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
            return y;
-       return x;
     }
     else
-       return Perl_atof(s);
+       Perl_atof2(s, x);
 #else
-    return Perl_atof(s);
+    Perl_atof2(s, x);
 #endif
+    return x;
 }
 
 void