U/compline/d_gconvert.U

   1 ?RCS: $Id: d_gconvert.U,v 3.0.1.3 1997/02/28 15:33:38 ram Exp $
   2 ?RCS:
   3 ?RCS: Copyright (c) 1991-1993, Raphael Manfredi
   4 ?RCS:
   5 ?RCS: You may redistribute only under the terms of the Artistic License,
   6 ?RCS: as specified in the README file that comes with the distribution.
   7 ?RCS: You may reuse parts of this distribution only within the terms of
   8 ?RCS: that same Artistic License; a copy of which may be found at the root
   9 ?RCS: of the source tree for dist 3.0.
  10 ?RCS:
  11 ?RCS: Original Author: Andy Dougherty <doughera@lafcol.lafayette.edu>
  12 ?RCS:
  13 ?RCS: $Log: d_gconvert.U,v $
  14 ?RCS: Revision 3.0.1.3  1997/02/28  15:33:38  ram
  15 ?RCS: patch61: integrated new unit from perl5
  16 ?RCS:
  17 ?RCS: Revision 3.0.1.2  1995/07/25  13:55:59  ram
  18 ?RCS: patch56: improved comments about the Gconvert macro (ADO)
  19 ?RCS: patch56: force compile-link test since it may exist but be unusable (ADO)
  20 ?RCS:
  21 ?RCS: Revision 3.0.1.1  1994/10/29  16:12:51  ram
  22 ?RCS: patch36: created by ADO
  23 ?RCS:
  24 ?MAKE:d_Gconvert: \
  25         Compile cat Inlibc rm _o rm_try i_stdlib d_qgcvt run \
  26         uselongdouble d_longdbl d_PRIgldbl sPRIgldbl
  27 ?MAKE:  -pick add $@ %<
  28 ?S:d_Gconvert:
  29 ?S:     This variable holds what Gconvert is defined as to convert
  30 ?S:     floating point numbers into strings.  By default, Configure
  31 ?S:     sets this macro to use the first of gconvert, gcvt, or sprintf
  32 ?S:     that pass sprintf-%g-like behavior tests.  If perl is using
  33 ?S:     long doubles, the macro uses the first of the following
  34 ?S:     functions that pass Configure's tests: qgcvt, sprintf (if
  35 ?S:     Configure knows how to make sprintf format long doubles--see
  36 ?S:     sPRIgldbl), gconvert, gcvt, and sprintf (casting to double).
  37 ?S:     The gconvert_preference and gconvert_ld_preference variables
  38 ?S:     can be used to alter Configure's preferences, for doubles and
  39 ?S:     long doubles, respectively.  If present, they contain a
  40 ?S:     space-separated list of one or more of the above function
  41 ?S:     names in the order they should be tried.
  42 ?S:
  43 ?S:     d_Gconvert may be set to override Configure with a platform-
  44 ?S:     specific function.  If this function expects a double, a
  45 ?S:     different value may need to be set by the uselongdouble.cbu
  46 ?S:     call-back unit so that long doubles can be formatted without
  47 ?S:     loss of precision.
  48 ?S:.
  49 ?C:Gconvert:
  50 ?C:     This preprocessor macro is defined to convert a floating point
  51 ?C:     number to a string without a trailing decimal point.  This
  52 ?C:     emulates the behavior of sprintf("%g"), but is sometimes much more
  53 ?C:     efficient.  If gconvert() is not available, but gcvt() drops the
  54 ?C:     trailing decimal point, then gcvt() is used.  If all else fails,
  55 ?C:     a macro using sprintf("%g") is used. Arguments for the Gconvert
  56 ?C:     macro are: value, number of digits, whether trailing zeros should
  57 ?C:     be retained, and the output buffer.
  58 ?C:     The usual values are:
  59 ?C:             d_Gconvert='gconvert((x),(n),(t),(b))'
  60 ?C:             d_Gconvert='gcvt((x),(n),(b))'
  61 ?C:             d_Gconvert='sprintf((b),"%.*g",(n),(x))'
  62 ?C:     The last two assume trailing zeros should not be kept.
  63 ?C:.
  64 ?H:#define Gconvert(x,n,t,b) $d_Gconvert
  65 ?H:.
  66 ?T: xxx_list xxx_convert xxx_ld_list
  67 ?F:!try
  68 ?LINT:extern gconvert_preference
  69 ?LINT:extern gconvert_ld_preference
  70 : Check how to convert floats to strings.
  71
  72 if test "X$d_Gconvert" = X; then
  73
  74 echo " "
  75 echo "Checking for an efficient way to convert floats to strings."
  76 echo " " > try.c
  77 case "$uselongdouble" in
  78 "$define") echo "#define USE_LONG_DOUBLE" >>try.c ;;
  79 esac
  80 case "$d_longdbl" in
  81 "$define") echo "#define HAS_LONG_DOUBLE" >>try.c ;;
  82 esac
  83 case "$d_PRIgldbl" in
  84 "$define") echo "#define HAS_PRIgldbl"    >>try.c ;;
  85 esac
  86 $cat >>try.c <<EOP
  87 #ifdef TRY_gconvert
  88 #define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
  89 const char *myname = "gconvert";
  90 #endif
  91 #ifdef TRY_gcvt
  92 #define Gconvert(x,n,t,b) gcvt((x),(n),(b))
  93 const char *myname = "gcvt";
  94 #endif
  95 #ifdef TRY_qgcvt
  96 #define Gconvert(x,n,t,b) qgcvt((x),(n),(b))
  97 const char *myname = "qgcvt";
  98 #define DOUBLETYPE long double
  99 #endif
 100 #ifdef TRY_sprintf
 101 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 102 #ifdef HAS_PRIgldbl
 103 #define Gconvert(x,n,t,b) sprintf((b),"%.*"$sPRIgldbl,(n),(x))
 104 #else
 105 #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(double)(x))
 106 #endif
 107 #else
 108 #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
 109 #endif
 110 const char *myname = "sprintf";
 111 #endif
 112
 113 #ifndef DOUBLETYPE
 114 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 115 #define DOUBLETYPE long double
 116 #else
 117 #define DOUBLETYPE double
 118 #endif
 119 #endif
 120
 121 #include <stdio.h>
 122
 123 #$i_stdlib I_STDLIB
 124 #ifdef I_STDLIB
 125 #include <stdlib.h>
 126 #endif
 127 #include <string.h>
 128
 129 void checkit(const char *expect, char *got)
 130 {
 131     if (strcmp(expect, got)) {
 132                 printf("%s oddity:  Expected %s, got %s\n",
 133                         myname, expect, got);
 134                 exit(1);
 135         }
 136 }
 137
 138 void lencheck(int expect, int got)
 139 {
 140     if (expect != got) {
 141                 printf("%s length mismatch:  Expected %d, got %d\n",
 142                         myname, expect, got);
 143                 exit(1);
 144         }
 145 }
 146
 147 int main()
 148 {
 149         char buf[64];
 150         buf[63] = '\0';
 151
 152         /* This must be 1st test on (which?) platform */
 153         /* Alan Burlison <AlanBurlsin@unn.unisys.com> */
 154         Gconvert((DOUBLETYPE)0.1, 8, 0, buf);
 155         checkit("0.1", buf);
 156
 157         Gconvert((DOUBLETYPE)0.01, 8, 0, buf);
 158         checkit("0.01", buf);
 159
 160         Gconvert((DOUBLETYPE)0.001, 8, 0, buf);
 161         checkit("0.001", buf);
 162
 163         Gconvert((DOUBLETYPE)0.0001, 8, 0, buf);
 164         checkit("0.0001", buf);
 165
 166         Gconvert((DOUBLETYPE)0.00009, 8, 0, buf);
 167         if (strlen(buf) > 5)
 168             checkit("9e-005", buf); /* for Microsoft ?? */
 169         else
 170             checkit("9e-05", buf);
 171
 172         Gconvert((DOUBLETYPE)1.0, 8, 0, buf);
 173         checkit("1", buf);
 174
 175         Gconvert((DOUBLETYPE)1.1, 8, 0, buf);
 176         checkit("1.1", buf);
 177
 178         Gconvert((DOUBLETYPE)1.01, 8, 0, buf);
 179         checkit("1.01", buf);
 180
 181         Gconvert((DOUBLETYPE)1.001, 8, 0, buf);
 182         checkit("1.001", buf);
 183
 184         Gconvert((DOUBLETYPE)1.0001, 8, 0, buf);
 185         checkit("1.0001", buf);
 186
 187         Gconvert((DOUBLETYPE)1.00001, 8, 0, buf);
 188         checkit("1.00001", buf);
 189
 190         Gconvert((DOUBLETYPE)1.000001, 8, 0, buf);
 191         checkit("1.000001", buf);
 192
 193         Gconvert((DOUBLETYPE)0.0, 8, 0, buf);
 194         checkit("0", buf);
 195
 196         Gconvert((DOUBLETYPE)-1.0, 8, 0, buf);
 197         checkit("-1", buf);
 198
 199         /* Some Linux gcvt's give 1.e+5 here. */
 200         Gconvert((DOUBLETYPE)100000.0, 8, 0, buf);
 201         checkit("100000", buf);
 202
 203         /* Some Linux gcvt's give -1.e+5 here. */
 204         Gconvert((DOUBLETYPE)-100000.0, 8, 0, buf);
 205         checkit("-100000", buf);
 206
 207         Gconvert((DOUBLETYPE)123.456, 8, 0, buf);
 208         checkit("123.456", buf);
 209
 210         /* Testing of 1e+129 in bigintpm.t must not get extra '.' here. */
 211         Gconvert((DOUBLETYPE)1e34, 8, 0, buf);
 212         /* 34 should be enough to scare even long double
 213          * places into using the e notation. */
 214         if (strlen(buf) > 5)
 215             checkit("1e+034", buf); /* for Microsoft */
 216         else
 217             checkit("1e+34", buf);
 218
 219         /* Test for an Ubuntu/Debian bug in gcvt and qgcvt. See:        *
 220          * https://bugs.launchpad.net/ubuntu/+source/glibc/+bug/1899553 */
 221
 222         Gconvert((DOUBLETYPE)0.4, 53, 0, buf);
 223         lencheck(55, (int)strlen(buf));
 224
 225         /* For Perl, if you add additional tests here, also add them to
 226          * t/base/num.t for benefit of platforms not using Configure or
 227          * overriding d_Gconvert */
 228
 229         exit(0);
 230 }
 231 EOP
 232 ?X: List of order in which to search for functions.
 233 ?X: Usual order of efficiency is gconvert gcvt sprintf
 234 ?X: If a hint file sets a d_Gconvert="gconvert" or "gcvt" or "sprintf",
 235 ?X: then that is taken as a hint for which function to try first.
 236 ?X: (e.g. that function may be in a problematic /usr/ucblib library, and
 237 ?X: the user may or may not choose to use -lucb stuff.)
 238 ?X: Any other hint file (or previous config.sh) setting is left intact.
 239 : first add preferred functions to our list
 240 xxx_list=""
 241 for xxx_convert in $gconvert_preference; do
 242     case $xxx_convert in
 243     gcvt|gconvert|sprintf) xxx_list="$xxx_list $xxx_convert" ;;
 244     *) echo "Discarding unrecognized gconvert_preference $xxx_convert" >&4 ;;
 245     esac
 246 done
 247 : then add any others
 248 for xxx_convert in gconvert gcvt sprintf; do
 249     case "$xxx_list" in
 250     *$xxx_convert*) ;;
 251     *) xxx_list="$xxx_list $xxx_convert" ;;
 252     esac
 253 done
 254
 255 case "$d_longdbl$uselongdouble" in
 256 "$define$define")
 257     : again, add preferred functions to our list first
 258     xxx_ld_list=""
 259     for xxx_convert in $gconvert_ld_preference; do
 260         case $xxx_convert in
 261         qgcvt|gcvt|gconvert|sprintf) xxx_ld_list="$xxx_ld_list $xxx_convert" ;;
 262         *) echo "Discarding unrecognized gconvert_ld_preference $xxx_convert" ;;
 263         esac
 264     done
 265     : then add qgcvt, sprintf--then, in xxx_list order, gconvert and gcvt
 266     for xxx_convert in qgcvt sprintf $xxx_list; do
 267         case "$xxx_ld_list" in
 268         $xxx_convert*|*" $xxx_convert"*) ;;
 269         *) xxx_ld_list="$xxx_ld_list $xxx_convert" ;;
 270         esac
 271     done
 272     : if sprintf cannot do long doubles, move it to the end
 273     if test "$d_PRIgldbl" != "$define"; then
 274         xxx_ld_list="`echo $xxx_ld_list|sed s/sprintf//` sprintf"
 275     fi
 276     : if no qgcvt, remove it
 277     if test "$d_qgcvt" != "$define"; then
 278         xxx_ld_list="`echo $xxx_ld_list|sed s/qgcvt//`"
 279     fi
 280     : use the ld_list
 281     xxx_list="$xxx_ld_list"
 282     ;;
 283 esac
 284
 285 for xxx_convert in $xxx_list; do
 286         echo "Trying $xxx_convert..."
 287 ?X: Do NOT use $rm_try here, as we need to keep try.c
 288         $rm -f try try$_o core
 289         set try -DTRY_$xxx_convert
 290         if eval $compile; then
 291                 echo "$xxx_convert() found." >&4
 292                 if $run ./try; then
 293                         echo "I'll use $xxx_convert to convert floats into a string." >&4
 294                         break;
 295                 else
 296                         echo "...But $xxx_convert didn't work as I expected."
 297                         xxx_convert=''
 298                 fi
 299         else
 300                 echo "$xxx_convert NOT found." >&4
 301                 xxx_convert=''
 302         fi
 303 done
 304
 305 if test X$xxx_convert = X; then
 306     echo "*** WHOA THERE!!! ***" >&4
 307     echo "None of ($xxx_list)  seemed to work properly.  I'll use sprintf." >&4
 308     xxx_convert=sprintf
 309 fi
 310
 311 case "$xxx_convert" in
 312 gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
 313 gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
 314 qgcvt) d_Gconvert='qgcvt((x),(n),(b))' ;;
 315 *) case "$uselongdouble$d_longdbl$d_PRIgldbl" in
 316    "$define$define$define")
 317       d_Gconvert="sprintf((b),\"%.*\"$sPRIgldbl,(n),(x))" ;;
 318    "$define$define$undef")
 319       d_Gconvert='sprintf((b),"%.*g",(n),(double)(x))' ;;
 320    *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
 321    esac
 322    ;;
 323 esac
 324
 325 fi
 326 $rm_try
 327