git.gag.com Git - debian/pforth/blob - t_floats.fth

   1 \ @(#) t_floats.fth 98/02/26 1.1 17:46:04
   2 \ Test ANS Forth FLOAT words.
   3 \
   4 \ Copyright 1994 3DO, Phil Burk
   5
   6 INCLUDE? }T{  t_tools.fth
   7
   8 ANEW TASK-T_FLOATS.FTH
   9
  10 DECIMAL
  11 3.14159265 fconstant PI
  12
  13 TEST{
  14 \ ==========================================================
  15 T{ 1 2 3 }T{ 1 2 3 }T
  16 \  ----------------------------------------------------- D>F F>D
  17 \ test some basic floating point <> integer conversion
  18 T{   4  0 D>F F>D  }T{   4  0 }T
  19 T{ 835  0 D>F F>D  }T{ 835  0 }T
  20 T{ -57 -1 D>F F>D  }T{ -57 -1 }T
  21 T{ 15 S>F 2 S>F F/ F>S }T{ 7 }T  \ 15.0/2.0 -> 7.5
  22
  23 \  ----------------------------------------------------- input
  24 T{ 79.2 F>S }T{ 79 }T
  25 T{ 0.003 F>S }T{ 0 }T
  26
  27 \ ------------------------------------------------------ F~
  28 T{  23.4  23.5  0.2   f~ }T{  true  }T
  29 T{  23.4  23.7  0.2   f~ }T{  false }T
  30 T{ 922.3 922.3  0.0   f~ }T{  true  }T
  31 T{ 922.3 922.31 0.0   f~ }T{  false }T
  32 T{   0.0   0.0  0.0   f~ }T{  true  }T
  33 T{   0.0  -0.0  0.0   f~ }T{  false }T
  34 T{  50.0  51.0 -0.02  f~ }T{  true  }T
  35 T{  50.0  51.0 -0.002 f~ }T{  false }T
  36 T{ 500.0 510.0 -0.02  f~ }T{  true  }T
  37 T{ 500.0 510.0 -0.002 f~ }T{  false }T
  38
  39 \ convert number to text representation and then back to float
  40 : T_F. ( -- ok? ) ( r ftol -f- )
  41         fover (f.) >float fswap f~
  42         AND
  43 ;
  44 : T_FS. ( -- ok? ) ( r -f- )
  45         fover (fs.) >float fswap f~
  46         AND
  47 ;
  48 : T_FE. ( -- ok? ) ( r -f- )
  49         fover (fe.) >float fswap f~
  50         AND
  51 ;
  52
  53 : T_FG. ( -- ok? ) ( r -f- )
  54         fover (f.) >float fswap f~
  55         AND
  56 ;
  57
  58 : T_F>D ( -- ok? ) ( r -f- )
  59         fover f>d d>f fswap f~
  60 ;
  61
  62 T{ 0.0  0.00001 T_F.  }T{  true  }T
  63 T{ 0.0  0.00001 T_FS.  }T{  true  }T
  64 T{ 0.0  0.00001 T_FE.  }T{  true  }T
  65 T{ 0.0  0.00001 T_FG.  }T{  true  }T
  66 T{ 0.0  0.00001 T_F>D  }T{  true  }T
  67
  68 T{ 12.34  -0.0001 T_F.  }T{  true  }T
  69 T{ 12.34  -0.0001 T_FS.  }T{  true  }T
  70 T{ 12.34  -0.0001 T_FE.  }T{  true  }T
  71 T{ 12.34  -0.0001 T_FG.  }T{  true  }T
  72 T{ 1234.0  -0.0001 T_F>D  }T{  true  }T
  73
  74 T{ 2345 S>F  79 S>F  F/  -0.0001 T_F.  }T{  true  }T
  75 T{ 511 S>F  -294 S>F  F/  -0.0001 T_F.  }T{  true  }T
  76
  77 : T.SERIES { N matchCFA | flag -- ok? } (  fstart fmult -f- )
  78         fswap  ( -- fmust fstart )
  79         true -> flag
  80         N 0
  81         ?DO
  82                 fdup -0.0001 matchCFA execute not
  83                 IF
  84                         false -> flag
  85                         ." T_F_SERIES failed for " i . fdup f. cr
  86                         leave
  87                 THEN
  88 \               i . fdup f. cr
  89                 fover f*
  90         LOOP
  91         matchCFA >name id. ."  T.SERIES final = " fs. cr
  92         flag
  93 ;
  94
  95 : T.SERIES_F.    ['] t_f.  t.series ;
  96 : T.SERIES_FS.   ['] t_fs. t.series ;
  97 : T.SERIES_FG.   ['] t_fg. t.series ;
  98 : T.SERIES_FE.   ['] t_fe. t.series ;
  99 : T.SERIES_F>D   ['] t_f>d t.series ;\r
 100
 101 T{  1.0     1.3       150 t.series_f.    }T{  true  }T
 102 T{  1.0    -1.3       150 t.series_f.    }T{  true  }T
 103 T{  2.3456789 1.3719  150 t.series_f.    }T{  true  }T
 104
 105 T{  3000.0  1.298     120 t.series_f>d   }T{  true  }T
 106
 107 T{  1.2     1.27751   150 t.series_fs.   }T{  true  }T
 108 T{  7.43    0.812255  200 t.series_fs.   }T{  true  }T
 109
 110 T{  1.195   1.30071   150 t.series_fe.   }T{  true  }T
 111 T{  5.913   0.80644   200 t.series_fe.   }T{  true  }T
 112
 113 T{  1.395   1.55071   120 t.series_fe.   }T{  true  }T
 114 T{  5.413   0.83644   160 t.series_fe.   }T{  true  }T
 115
 116 \  ----------------------------------------------------- FABS
 117 T{  0.0   FABS  0.0         0.00001 F~    }T{  true  }T
 118 T{  7.0   FABS  7.0         0.00001 F~    }T{  true  }T
 119 T{ -47.3  FABS  47.3        0.00001 F~    }T{  true  }T
 120
 121 \  ----------------------------------------------------- FSQRT
 122 T{  49.0  FSQRT  7.0       -0.0001 F~    }T{  true  }T
 123 T{  2.0   FSQRT  1.414214  -0.0001 F~    }T{  true  }T
 124
 125 \  ----------------------------------------------------- FSIN
 126 T{  0.0   FSIN  0.0         0.00001 F~    }T{  true  }T
 127 T{  PI    FSIN  0.0         0.00001 F~    }T{  true  }T
 128 T{  PI 2.0 F*  FSIN   0.0   0.00001 F~    }T{  true  }T
 129 T{  PI 0.5 F*  FSIN   1.0   0.00001 F~    }T{  true  }T
 130 T{  PI 6.0 F/  FSIN   0.5   0.00001 F~    }T{  true  }T
 131
 132 \  ----------------------------------------------------- \
 133 }TEST
 134