1 This version includes checks to see if `extended precision' is
2 used in expressions, but does not determine the characteristics.
5 > module Main (main) where
10 > version = "@(#)TestLIAS.lhs 1.2 dated 92/07/31 at 08:53:52"
18 > maxInt, minInt :: Int
20 > minInt = minBound + 1 -- NOTA BENE: this program does (minInt `rem` (-1)), and
21 > -- that gives an exception if minInt = minBound,
22 > -- because the result of the division is too big to fit
24 > main = (initial_checks flp_parms . main_identities flp_parms .
25 > notification_checks flp_parms) (return ())
27 > flp_parms = makeFloatParms flp_val
29 Data type for representing parameters of a RealFloat.
30 AN element has the form
31 (MkFloatParms r p emin emax denorm fmax fmin fminN epsilon)
33 > data (RealFloat a) =>
34 > FloatParms a = MkFloatParms Integer Int Int Int Bool a a a a
36 > makeFloatParms :: (RealFloat a) => a -> FloatParms a
38 > = MkFloatParms (floatRadix x) (floatDigits x) (emin x) (emax x)
39 > (denorm x) (fmax x) (fmin x) (fminN x) (epsilon x)
41 > initial_checks :: (RealFloat a) => FloatParms a -> Cont -> Cont
42 > initial_checks (MkFloatParms r p eemin eemax ddenorm ffmax ffmin ffminN eps)
43 > = -- text is output here to form the basis of a report.
45 > showits "LIAS Model Implementation " . showits version . new_line .
47 > showits "Test results" . new_line .
48 > showits "Computer: " . new_line .
49 > showits "Compiler: " . new_line .
50 > showits "Options used: " . new_line .
51 > showits "Program modifications (with reasons): " . new_line .
52 > showits "Date tested: " . new_line .
53 > showits "Tested by: " . new_line .
55 > showits "Integer type (int) name " . showits int_name . new_line .
56 > showits "Floating point type (flp) name " . showits flp_name .
57 > new_line . new_line .
58 > showits "Parameter values" . new_line .
59 > showits " minint, maxint" .
61 > showits (pad 15 (show minInt)) . showits (pad 15 (show maxInt)) .
63 > showits " r, p, emin, emax, denorm" .
65 > showits (pad 3 (show r)) .
66 > showits (pad 4 (show p)) .
67 > showits (pad 8 (show eemin)) . showits (pad 8 (show eemax)) .
73 > showits "fmax " . showit ffmax . new_line .
74 > showits "fmin " . showit ffmin . new_line .
75 > showits "fminn " . showit ffminN . new_line .
76 > showits "epsilon " . showit eps . new_line .
77 > (if (r `mod` 2 /= 0) || (r < 0) then
78 > showits "floatRadix value is not positive even integer" .
81 > (if fromIntegral (p -1) * log (fromInteger r)
83 > -- the accuracy of the log function used here is not critical
84 > showits "precision less than six decimal floatDigits" .
87 > (if (eemin -1) >= -2*(fromInteger r -1) then
88 > showits "Exponent minimum too large" .
91 > (if eemax <= 2*(fromInteger r -1) then
92 > showits "Exponent maximum not large enough" .
95 > (if (-2 > eemin -1+eemax) ||
96 > (eemin -1+eemax > 2) then
97 > showits "Exponent range not roughly symmetric" .
102 > equal_int :: (Integral a) => (a, a, Int) -> Cont -> Cont
103 > equal_int (i,j, test_number)
104 > | i /= j = showits "Integer operation check number " .
105 > showit test_number . showits " fails with " .
106 > showit i . showits " ". showit j . new_line
107 > | True = showits "Integer operation check number " . showit test_number . showits " ok " . new_line
109 > equal_flp :: (RealFloat a) => (a, a, Int) -> Cont -> Cont
110 > equal_flp (x, y, test_number)
111 > | x /= y = showits "Floating point operation check number " .
112 > showit test_number . showits " fails" . new_line .
113 > showit x . showits " " . showit y . new_line
114 > | True = showits "Floating operation check number " . showit test_number . showits " ok " . new_line
116 > test_true :: (Bool, Int) -> Cont -> Cont
117 > test_true (b, test_number)
118 > | not b = showits "Predicate number " . showit test_number .
119 > showits " fails " . showit b . new_line
120 > | True = showits "Predicate number " . showit test_number . showits " ok " . new_line
122 > -- This procedure checks that sqrt(y*y) = y when y*y is exact
123 > check_exact_squares :: (RealFloat a) => FloatParms a -> Cont -> Cont
124 > check_exact_squares (MkFloatParms r p eemin eemax ddenorm
125 > ffmax ffmin ffminN eps)
126 > = foldr (.) id (map foo list)
128 > list = takeWhile in_range (iterate mul 10)
129 > mul y = fromInteger (truncate (1.2 * y)) :: Float
130 > in_range y = exponent y < p `div` 2
131 > foo y = if y /= sqrt (fromInteger (truncate (y * y)))
132 > then showits "Square root not exact for a square" .
133 > showit y . new_line
136 > flp :: (Integral a, RealFloat b) => a -> b
139 > int_part :: (RealFloat a) => a -> a
140 > int_part x = flp (truncate x)
142 > main_identities :: (RealFloat a) => FloatParms a -> Cont -> Cont
143 > main_identities flp_parms@(MkFloatParms r p eemin eemax ddenorm
144 > ffmax ffmin ffminN eps)
145 > = equal_int(-(-maxInt), maxInt, 1) .
146 > equal_int(2+2, 2*2, 2) .
147 > equal_int(minInt `rem` (-1), 0, 3) .
148 > equal_flp(1.0+1.0, 2.0, 4) .
149 > equal_flp(ffmax-1.0, ffmax, 5) .
150 > equal_flp(ffmax/2.0+ffmax/2.0, ffmax, 6) .
151 > equal_flp(ffmax/ffmax, 1.0, 7) .
152 > equal_flp((ffmax/flp(r))*flp(r), ffmax, 8) .
153 > equal_flp(ffmin/ffmin, 1.0, 9) .
154 > equal_flp(-(-1.1), 1.1, 10) .
155 > equal_flp(abs(-ffmax), ffmax, 11) .
156 > equal_flp(abs(-ffminN), ffminN, 12) .
157 > equal_flp(signf(-ffmin), -1.0, 13) .
158 > equal_flp(signf(0.0), 1.0, 14) .
159 > equal_flp(signf(ffmin), 1.0, 15) .
160 > -- NDN Tests 16-25 changed as they were incorrect
161 > equal_int(exponent 1.0, 1, 16) .
162 > equal_int(exponent 1.6, 1, 17) .
163 > equal_int(exponent(flp(r)), 2, 18) .
164 > equal_int(exponent(ffmax), eemax, 19) .
165 > equal_int(exponent(ffminN), eemin, 20) .
167 > equal_int(exponent(ffmin), eemin-p+1, 21)
169 > equal_flp(significand(0.9), 0.9, 22) .
170 > equal_flp(significand(1.0), scaleFloat (-1) 1, 23) .
171 > -- NDN This fails on hbc. I'm not sure if the test is correct.
172 > equal_flp(significand(ffmax), predf(1), 24) .
173 > -- equal_flp(significand(-ffmin), -1.0, 25) .
174 > equal_flp(scaleFloat 1 1.1, 1.1*flp(r), 26) .
175 > equal_flp(scaleFloat (-11) (scaleFloat 11 1.7), 1.7, 27) .
176 > equal_flp(succf(1.0), 1.0+eps, 28) .
177 > -- NDN Test 29 changed as it was incorrect
178 > equal_flp(succf(significand(ffmax)), 1.0, 29) .
179 > equal_flp(succf(-ffmin), 0.0, 30) .
180 > equal_flp(succf(0.0), ffmin, 31) .
181 > equal_flp(predf(succf(ffmin)), ffmin, 32) .
182 > test_true(predf(flp(r)) < flp(r), 33) .
183 > test_true(predf 1.1 < 1.1, 34) .
184 > equal_flp(predf(succf 1.2), 1.2, 35) .
185 > equal_flp(ulpf(1.0), eps, 36) .
186 > equal_flp(flp(r)*ulpf(predf 1.0), eps, 37) .
187 > equal_flp(succf(predf(ffmax)), ffmax, 38) .
188 > equal_flp(truncf (1.0 + 3.0*eps) p, 1.0 + 3.0*eps, 39) .
189 > equal_flp(truncf (1.0 + 3.0*eps) (p-1), 1.0 + 2.0*eps, 40) .
190 > equal_flp(truncf (1.0 + 3.0*eps) (p-2), 1.0, 41) .
191 > equal_flp(roundf (1.0 + 3.0*eps) p, 1.0 + 3.0*eps, 42) .
192 > equal_flp(roundf (1.0 + 3.0*eps) (p-1), 1.0 + 4.0*eps, 43) .
193 > equal_flp(roundf (1.0 + 3.0*eps) (p-2), 1.0 + 4.0*eps, 44) .
194 > equal_flp(int_part 1.0, 1.0, 45) .
195 > equal_flp(int_part(succf 1.0), 1.0, 46) .
196 > equal_flp(int_part(predf 2.0), 1.0, 47) .
197 > equal_flp(int_part(-ffmin), 0.0, 48) .
198 > equal_flp(int_part(ffmin), 0.0, 49) .
199 > equal_flp(fractpart(ffmax), 0.0, 50) .
200 > equal_flp(fractpart(ffmin), ffmin, 51) .
201 > equal_flp(fractpart(succf 1.0), eps, 52) .
202 > equal_flp(fractpart(flp(r)), 0.0, 53) .
203 > equal_flp(fractpart(-ffmin), -ffmin, 54) .
204 > test_true(ffmin > 0.0, 55) .
205 > test_true(-ffmax < -ffmin, 56) .
206 > check_exact_squares flp_parms .
207 > -- equal_int(int(predf 3.5), 3, 57) .
208 > -- equal_int(int(succf 3.5), 4, 58) .
209 > -- equal_int(int(predf -3.5), -4, 59) .
210 > -- equal_flp(flp(int(-5.0)), -5.0, 60) .
211 > -- equal_flp(flp(int(-5.6)), -6.0, 61) .
212 > -- equal_flp(scaleFloat (eemax+1) (ffminN),
213 > -- flp(r) ^^ integer(eemax+eemin), 62) .
214 > -- equal_flp(scaleFloat(ffmax, eemin-2),
215 > -- significand(ffmax) *
216 > -- flp(r) ^^ integer(eemax+eemin-3), 63) .
217 > -- check_conversions .
220 > notification_checks :: (RealFloat a) => FloatParms a -> Cont -> Cont
221 > notification_checks (MkFloatParms r p eemin eemax ddenorm
222 > ffmax ffmin ffminN eps)
223 > = showits "Test condition tested notify result(ce/ne/other/no)" .
225 > let my_maxint = maxInt in
226 > showits " 1 addi overflow pos overf " .
227 > showit (my_maxint + 1) .
229 > showits " 2 addi overflow neg overf " .
230 > (let tempi1 = -minInt ; tempi2 = -1 in
231 > showit (tempi1 + tempi2)) .
233 > showits " 3 subi overflow neg overf " .
234 > showit (minInt - 1) .
236 > showits " 4 subi overflow pos overf " .
237 > (let tempi1 = maxInt ; tempi2 = -1 in
238 > showit (tempi1 - tempi2)) .
240 > showits " 5 muli overflow pos overf " .
241 > (let tempi1 = my_maxint `div` 2 + 1 ; tempi2 = 2 in
242 > showit (tempi1 * tempi2)) .
244 > showits " 6 muli overflow neg overf " .
245 > (let tempi1 = -2 ; tempi2 = my_maxint `div` 2 + 2 in
246 > showit (tempi1 * tempi2)) .
248 > showits " 7 int divide by zero zerod " .
249 > (let tempi1 = 1 ; tempi2 = my_maxint - maxInt in
250 > showit (tempi1 `div` tempi2)) .
252 > showits " 8 int divide by zero zerod " .
253 > showit (1 `div` (my_maxint-maxInt)) .
255 > showits " 9 remi divide by 0 zerod " .
256 > showit (1 `rem` (my_maxint - maxInt)) .
258 > showits "10 modi divide by 0 zerod " .
259 > (let tempi1 = 1 ; tempi2 = my_maxint - maxInt in
260 > showit (tempi1 `mod` tempi2)) .
262 > showits "11 divide by zero zerod " .
263 > showit (1 `div` (my_maxint-maxInt)) .
265 > showits "12 divide by zero zerod " .
266 > showit (1 `div` (my_maxint-maxInt)) .
268 > -- showits "13 addf overflow overf " .
269 > -- showit (ffmax + flp(r) ** integer(eemax-p+1)) .
271 > -- showits "14 subf overflow overf " .
272 > -- showit (-ffmax - flp(r) ** integer(eemax-p+1)) .
274 > showits "15 mulf overflow overf " .
275 > showit (ffmax * 1.001) .
277 > showits "16 divf overflow overf " .
278 > showit (ffmax / 0.7) .
280 > showits "17 divf by zero zerod " .
281 > (let tempf1 = flp(my_maxint-maxInt) in
282 > showit (1.0 / tempf1)) .
284 > showits "18 sqrt of tiny neg undef " .
285 > showit (sqrt(-ffmin)) .
287 > showits "19 exponentf(zero) undef " .
288 > (let tempf1 = flp(my_maxint-maxInt) in
289 > showit (exponent(tempf1))) .
291 > showits "20 succf of fmax overf " .
292 > showit (succf(ffmax)) .
294 > showits "21 predf of -fmax overf " .
295 > showit (predf(-ffmax)) .
297 > showits "22 ulpf(zero) undef " .
298 > showit (ulpf(0.0)) .
300 > showits "23 roundf to 0 p undef " .
301 > showit (roundf 1.0 0) .
303 > showits "24 roundf overflow overf " .
304 > showit (roundf ffmax 2) .
306 > -- showits "25 trunc overflow overf " .
307 > -- (if flp(maxInt) < max_mantissa then
308 > -- showit (int(flp(maxInt)+1.0))
310 > -- showit (int(succf(flp(maxInt))))) .
312 > -- showits "26 round overflow overf " .
313 > -- (if flp(maxInt) < max_mantissa then
314 > -- showit (int(flp(minInt)-1.0))
316 > -- showit (int(predf(flp(minInt)))))