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