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

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

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

File size: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Aug 20 06:36:35 2003
4;;;; Contains: Tests of FTRUNCATE
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9(compile-and-load "ftruncate-aux.lsp")
10
11;;; Error tests
12
13(deftest ftruncate.error.1
14  (signals-error (ftruncate) program-error)
15  t)
16
17(deftest ftruncate.error.2
18  (signals-error (ftruncate 1.0 1 nil) program-error)
19  t)
20
21;;; Non-error tests
22
23(deftest ftruncate.1
24  (ftruncate.1-fn)
25  nil)
26
27(deftest ftruncate.10
28  (loop for x in (remove-if #'zerop *reals*)
29        for (q r) = (multiple-value-list (ftruncate 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 ftruncate.11
42  (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
43        for (q r) = (multiple-value-list (ftruncate  (- 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 ftruncate.12
56  (let* ((radix (float-radix 1.0s0))
57         (rad (float radix 1.0s0))
58         (rrad (/ 1.0s0 rad)))
59    (loop for i from 1 to 1000
60          for x = (+ i rrad)
61          for (q r) = (multiple-value-list (ftruncate 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 ftruncate.13
68  (let* ((radix (float-radix 1.0s0))
69         (rad (float radix 1.0s0))
70         (rrad (/ 1.0s0 rad)))
71    (loop for i from 1 to 1000
72          for x = (- i rrad)
73          for (q r) = (multiple-value-list (ftruncate x))
74          unless (and (eql q (coerce (1- i) 'short-float))
75                      (eql r rrad))
76          collect (list i x q r)))
77  nil)
78
79(deftest ftruncate.14
80  (let* ((radix (float-radix 1.0f0))
81         (rad (float radix 1.0f0))
82         (rrad (/ 1.0f0 rad)))
83    (loop for i from 1 to 1000
84          for x = (+ i rrad)
85          for (q r) = (multiple-value-list (ftruncate 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 ftruncate.15
92  (let* ((radix (float-radix 1.0f0))
93         (rad (float radix 1.0f0))
94         (rrad (/ 1.0f0 rad)))
95    (loop for i from 1 to 1000
96          for x = (- i rrad)
97          for (q r) = (multiple-value-list (ftruncate x))
98          unless (and (eql q (coerce (1- i) 'single-float))
99                      (eql r rrad))
100          collect (list i x q r)))
101  nil)
102
103(deftest ftruncate.16
104  (let* ((radix (float-radix 1.0d0))
105         (rad (float radix 1.0d0))
106         (rrad (/ 1.0d0 rad)))
107    (loop for i from 1 to 1000
108          for x = (+ i rrad)
109          for (q r) = (multiple-value-list (ftruncate 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 ftruncate.17
116  (let* ((radix (float-radix 1.0d0))
117         (rad (float radix 1.0d0))
118         (rrad (/ 1.0d0 rad)))
119    (loop for i from 1 to 1000
120          for x = (- i rrad)
121          for (q r) = (multiple-value-list (ftruncate x))
122          unless (and (eql q (coerce (1- i) 'double-float))
123                      (eql r rrad))
124          collect (list i x q r)))
125  nil)
126
127(deftest ftruncate.18
128  (let* ((radix (float-radix 1.0l0))
129         (rad (float radix 1.0l0))
130         (rrad (/ 1.0l0 rad)))
131    (loop for i from 1 to 1000
132          for x = (+ i rrad)
133          for (q r) = (multiple-value-list (ftruncate 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 ftruncate.19
140  (let* ((radix (float-radix 1.0l0))
141         (rad (float radix 1.0l0))
142         (rrad (/ 1.0l0 rad)))
143    (loop for i from 1 to 1000
144          for x = (- i rrad)
145          for (q r) = (multiple-value-list (ftruncate x))
146          unless (and (eql q (coerce (1- i) 'long-float))
147                      (eql r rrad))
148          collect (list i x q r)))
149  nil)
150
151;;; To add: tests that involve adding/subtracting EPSILON constants
152;;; (suitably scaled) to floated integers.
Note: See TracBrowser for help on using the repository browser.