source: trunk/source/tests/ansi-tests/fround.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Aug 21 16:07:59 2003
4;;;; Contains: Tests of FROUND
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9(compile-and-load "fround-aux.lsp")
10
11;;; Error tests
12
13(deftest fround.error.1
14  (signals-error (fround) program-error)
15  t)
16
17(deftest fround.error.2
18  (signals-error (fround 1.0 1 nil) program-error)
19  t)
20
21;;; Non-error tests
22
23(deftest fround.1
24  (fround.1-fn)
25  nil)
26
27(deftest fround.10
28  (loop for x in (remove-if #'zerop *reals*)
29        for (q r) = (multiple-value-list (fround x x))
30        unless (and (floatp q)
31                    (if (floatp x)
32                        (eql q (float 1 x))
33                      (= q 1))
34                    (zerop r)
35                    (if (floatp x)
36                        (eql r (float 0 x))
37                      (= r 0)))
38        collect x)
39  nil)
40
41(deftest fround.11
42  (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
43        for (q r) = (multiple-value-list (fround  (- x) x))
44        unless (and (floatp q)
45                    (if (floatp x)
46                        (eql q (float -1 x))
47                      (= q -1))
48                    (zerop r)
49                    (if (floatp x)
50                        (eql r (float 0 x))
51                      (= r 0)))
52        collect x)
53  nil)
54
55(deftest fround.12
56  (let* ((radix (float-radix 1.0s0))
57         (rad (float radix 1.0s0))
58         (rrad (/ 0.5s0 rad)))
59    (loop for i from 1 to 1000
60          for x = (+ i rrad)
61          for (q r) = (multiple-value-list (fround x))
62          unless (and (eql q (coerce i 'short-float))
63                      (eql r rrad))
64          collect (list i x q r)))
65  nil)
66
67(deftest fround.13
68  (let* ((radix (float-radix 1.0s0))
69         (rad (float radix 1.0s0))
70         (rrad (/ 0.5s0 rad)))
71    (loop for i from 1 to 1000
72          for x = (- i rrad)
73          for (q r) = (multiple-value-list (fround x))
74          unless (and (eql q (coerce i 'short-float))
75                      (eql r (- rrad)))
76          collect (list i x q r)))
77  nil)
78
79(deftest fround.14
80  (let* ((radix (float-radix 1.0f0))
81         (rad (float radix 1.0f0))
82         (rrad (/ 0.5f0 rad)))
83    (loop for i from 1 to 1000
84          for x = (+ i rrad)
85          for (q r) = (multiple-value-list (fround x))
86          unless (and (eql q (coerce i 'single-float))
87                      (eql r rrad))
88          collect (list i x q r)))
89  nil)
90
91(deftest fround.15
92  (let* ((radix (float-radix 1.0f0))
93         (rad (float radix 1.0f0))
94         (rrad (/ 0.5f0 rad)))
95    (loop for i from 1 to 1000
96          for x = (- i rrad)
97          for (q r) = (multiple-value-list (fround x))
98          unless (and (eql q (coerce  i 'single-float))
99                      (eql r (- rrad)))
100          collect (list i x q r)))
101  nil)
102
103(deftest fround.16
104  (let* ((radix (float-radix 1.0d0))
105         (rad (float radix 1.0d0))
106         (rrad (/ 0.5d0 rad)))
107    (loop for i from 1 to 1000
108          for x = (+ i rrad)
109          for (q r) = (multiple-value-list (fround x))
110          unless (and (eql q (coerce i 'double-float))
111                      (eql r rrad))
112          collect (list i x q r)))
113  nil)
114
115(deftest fround.17
116  (let* ((radix (float-radix 1.0d0))
117         (rad (float radix 1.0d0))
118         (rrad (/ 0.5d0 rad)))
119    (loop for i from 1 to 1000
120          for x = (- i rrad)
121          for (q r) = (multiple-value-list (fround x))
122          unless (and (eql q (coerce i 'double-float))
123                      (eql r (- rrad)))
124          collect (list i x q r)))
125  nil)
126
127(deftest fround.18
128  (let* ((radix (float-radix 1.0l0))
129         (rad (float radix 1.0l0))
130         (rrad (/ 0.5l0 rad)))
131    (loop for i from 1 to 1000
132          for x = (+ i rrad)
133          for (q r) = (multiple-value-list (fround x))
134          unless (and (eql q (coerce i 'long-float))
135                      (eql r rrad))
136          collect (list i x q r)))
137  nil)
138
139(deftest fround.19
140  (let* ((radix (float-radix 1.0l0))
141         (rad (float radix 1.0l0))
142         (rrad (/ 0.5l0 rad)))
143    (loop for i from 1 to 1000
144          for x = (- i rrad)
145          for (q r) = (multiple-value-list (fround x))
146          unless (and (eql q (coerce i 'long-float))
147                      (eql r (- rrad)))
148          collect (list i x q r)))
149  nil)
Note: See TracBrowser for help on using the repository browser.