(       Title:  Dirk Zoller's Float Tests
         File:  dztest-float.fs
  Modified by:  David N. Williams
      License:  LGPL
Starting date:  December 12, 2002
Version 1.0.0:  December 12, 2002
Version 1.0.1:  December 14, 2002
)
\ Copyright (C) 1993 Dirk Zoller
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
MA 02111-1307 USA.

This is Dirk Zoller's test/float.4th rewritten for ftester.fs.  Here's
his description:
)
\ test/float.4th ---	Does a few tests of the floating point word set.
\			Only the most basic things.
\ (duz 05Aug93)

s" ftester.fs" included
\ MARKER FORGET-FLOAT-TESTS

true verbose !
decimal

: f{{  f{ { ;
: }}f  } }f ;

testing F~

set-exact
f{  1.0e0  1.0e0  0e f~ f-> }f  { -> true } 
f{  1.0e0  1.0e0 -0e f~ f-> }f  { -> true } 
f{  1.0e0  1.1e0  0e f~ f-> }f  { -> false } 

f{  1.000000e0   1.000001e0    0.0000011e0 f~ f-> }f  { -> true } 
f{ -1.000000e0  -1.000001e0    0.0000011e0 f~ f-> }f  { -> true } 
f{  1.000000e0   1.000001e0    0.0000009e0 f~ f-> }f  { -> false } 
f{  1.000000e0  -1.000001e0    0.0000011e0 f~ f-> }f  { -> false } 
f{ -1.000000e0   1.000001e0    0.0000011e0 f~ f-> }f  { -> false } 

f{  1.000000e10  1.000001e10  -0.0000006e0 f~ f-> }f  { -> true } 
f{ -1.000000e10 -1.000001e10  -0.0000006e0 f~ f-> }f  { -> true } 
f{  1.000000e10  1.000001e10  -0.0000004e0 f~ f-> }f  { -> false } 
f{  1.000000e10 -1.000001e10  -0.0000006e0 f~ f-> }f  { -> false } 
f{ -1.000000e10  1.000001e10  -0.0000006e0 f~ f-> }f  { -> false } 

f{  4e-15  0e     0e    f~ f-> }f  { -> false }
f{  4e-15  0e    -0e    f~ f-> }f  { -> false }
f{ -4e-15 -0e     1e-14 f~ f-> }f  { -> true }
f{  4e-15  2e-15 -1e-15 f~ f-> }f  { -> false } 
f{  4e-15  2e-15 -0.3e  f~ f-> }f  { -> false } 

testing floating point number input

f{{ 1e0 1. d>f fexactly= -> true f-> }}f

testing >FLOAT

set-exact
f{{ s" "         >float -> true f-> 0e0  }}f
f{{ s"      "    >float -> true f-> 0e0  }}f
f{{ s" 0e "      >float -> true f-> 0e0  }}f
f{{ s"  0e0   "  >float -> true f-> 0e0  }}f
f{{ s"  +0d  "   >float -> true f-> 0e0  }}f
f{{ s"  0e+0  "  >float -> true f-> 0e0  }}f
f{{ s" 1-1"      >float -> true f-> 1e-1 }}f
f{{ s"  1-1   "  >float -> true f-> 1e-1 }}f
f{{ s"  1+1   "  >float -> true f-> 1e1  }}f
f{{ s"  1      " >float -> true f-> 1e0  }}f
f{{ s"  1.e+1  " >float -> true f-> 1e1  }}f
f{{ s"  .1e+1  " >float -> true f-> 1e0  }}f
f{{ s" 10e-1"    >float -> true f-> 1e0  }}f

set-near
f{{ s"  -1.e+0"     >float -> true f-> -1e0        }}f
f{{ s"  -.1e+1"     >float -> true f-> -1e0        }}f
f{{ s" -10.e-1"     >float -> true f-> -1e0        }}f
f{{ s" +1234.56e-9" >float -> true f-> +1234.56e-9 }}f
f{{ s" -1234.56e-9" >float -> true f-> -1234.56e-9 }}f

testing floating point constants and variables

set-exact
f{{ +.1234567e+09 fconstant fc1 fc1 123456700. d>f fexactly= -> true f-> }}f
f{{ -.7654321e-34 fconstant fc2 fc2 -.7654321e-34  fexactly= -> true f-> }}f

f{{ fvariable fv1       fc1 fv1     f! f-> -> }}f
f{{ fvariable fvaria2	fc2 fvaria2 f! f-> -> }}f

f{{ fv1 f@     f-> fc1 -> }}f
f{{ fvaria2 f@ f-> fc2 -> }}f

f{{ fc2 fv1 f!       fv1 f@     f-> fc2 -> }}f
f{{ fc1 fvaria2 f!   fvaria2 f@ f-> fc1 -> }}f

testing floating point stack operations

set-exact
f{{ fc1 fc2     fdrop f-> fc1         -> }}f
f{{ fc1 fc2     fdup  f-> fc1 fc2 fc2 -> }}f
f{{ fc1 fc2     fswap f-> fc2 fc1     -> }}f
f{{ fc1 fc2     fover f-> fc1 fc2 fc1 -> }}f
f{{ fc1 fc2 1e0 frot  f-> fc2 1e0 fc1 -> }}f

testing REPRESENT

: test-represent  (f: r s: addr len -- n neg? compare? )
(
Compare the input significand string [ addr len] to the
significand string produced by REPRESENT for the input len and
the number r.  Assume that r is in the implementation-defined
valid range.  Leave the exponent n and sign flag neg? produced
by REPRESENT, and leave compare?, the significand agreement
flag.
)
  ( len) >r    pad 80 0 fill
  pad r@ represent ( valid.range?) drop (  n neg?)
  pad r@ + c@ ABORT" ***REPRESENT writes too many characters." 
  rot ( n neg? addr) r@ pad r> compare 0= ;

\ meaning of TEST-REPRESENT neg? output
: plus  ( -- false )  false ;
: minus  ( -- true )  true ;

set-exact
f{{ 0e0 s" 0"           test-represent -> 0 plus true f-> }}f
f{{ 0e0 s" 000"         test-represent -> 0 plus true f-> }}f
f{{ 0e0 s" 0000000"     test-represent -> 0 plus true f-> }}f
f{{ 0e0 s" 00000000000" test-represent -> 0 plus true f-> }}f

f{{  1e0 s" 1"           test-represent -> 1 plus  true f-> }}f
f{{ -1e0 s" 100"         test-represent -> 1 minus true f-> }}f
f{{  1e0 s" 1000000"     test-represent -> 1 plus  true f-> }}f
f{{ -1e0 s" 10000000000" test-represent -> 1 minus true f-> }}f

f{{  1e1  s" 1"           test-represent ->  2 plus  true f-> }}f
f{{ -1e3  s" 100"         test-represent ->  4 minus true f-> }}f
f{{  1e5  s" 1000000"     test-represent ->  6 plus  true f-> }}f
f{{ -1e11 s" 10000000000" test-represent -> 12 minus true f-> }}f

f{{ 0.950000001e1  s" 1"         test-represent ->  2 plus  true f-> }}f
f{{     -0.9994e3  s" 999"       test-represent ->  3 minus true f-> }}f
f{{ .9999999501e5  s" 1000000"   test-represent ->  6 plus  true f-> }}f
f{{ -.99999999e30  s" 999999990" test-represent -> 30 minus true f-> }}f

f{{ 0.950000001e-1   s" 1"         test-represent ->   0 plus  true f-> }}f
f{{     -0.9994e-3   s" 999"       test-represent ->  -3 minus true f-> }}f
f{{   .99999995e-5   s" 1000000"   test-represent ->  -4 plus  true f-> }}f
f{{  -.99999999e-30  s" 999999990" test-represent -> -30 minus  true f-> }}f

f{{  123456789e1   s" 1"         test-represent -> 10 plus  true f-> }}f
f{{ -123456789e3   s" 123"       test-represent -> 12 minus true f-> }}f
f{{  123456789e5   s" 1234568"   test-represent -> 14 plus  true f-> }}f
f{{ -123456789e30  s" 123456789" test-represent -> 39 minus true f-> }}f

f{{  123456789e-1   s" 1"         test-represent ->   8 plus  true f-> }}f
f{{ -123456789e-3   s" 123"       test-represent ->   6 minus true f-> }}f
f{{  123456789e-5   s" 1234568"   test-represent ->   4 plus  true f-> }}f
f{{ -123456789e-30  s" 123456789" test-represent -> -21 minus true f-> }}f

testing FROUND

set-exact
f{{ 1e fround f-> 1e -> }}f

f{  1.4e fround f->  1.0e }f
f{  1.7e fround f->  2.0e }f
f{ -1.4e fround f-> -1.0e }f
f{ -1.7e fround f-> -2.0e }f

f{  0.5e fround f->  0.0e }f
f{  1.5e fround f->  2.0e }f
f{  2.5e fround f->  2.0e }f
f{  3.5e fround f->  4.0e }f

f{ -0.5e fround f-> -0.0e }f
f{ -1.5e fround f-> -2.0e }f
f{ -2.5e fround f-> -2.0e }f
f{ -3.5e fround f-> -4.0e }f

f{{  4e9  0.5e f+ fround f>d ->  4000000000. } f-> }f
f{{  4e9  1.5e f+ fround f>d ->  4000000002. } f-> }f
f{{ -4e9 -0.5e f+ fround f>d -> -4000000000. } f-> }f
f{{ -4e9 -1.5e f+ fround f>d -> -4000000002. } f-> }f

\ FORGET-FLOAT-TESTS