← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/floor.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/floor.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Mon Aug  4 22:16:00 2003
 
4
;;;; Contains: Tests of FLOOR
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "numbers-aux.lsp")
 
9
(compile-and-load "floor-aux.lsp")
 
10
 
 
11
;;; Error tests
 
12
 
 
13
(deftest floor.error.1
 
14
  (signals-error (floor) program-error)
 
15
  t)
 
16
 
 
17
(deftest floor.error.2
 
18
  (signals-error (floor 1.0 1 nil) program-error)
 
19
  t)
 
20
 
 
21
;;; Non-error tests
 
22
 
 
23
(deftest floor.1
 
24
  (floor.1-fn)
 
25
  nil)
 
26
 
 
27
(deftest floor.2
 
28
  (floor.2-fn)
 
29
  nil)
 
30
 
 
31
(deftest floor.3
 
32
  (floor.3-fn 2.0s4)
 
33
  nil)
 
34
 
 
35
(deftest floor.4
 
36
  (floor.3-fn 2.0f4)
 
37
  nil)
 
38
 
 
39
(deftest floor.5
 
40
  (floor.3-fn 2.0d4)
 
41
  nil)
 
42
 
 
43
(deftest floor.6
 
44
  (floor.3-fn 2.0l4)
 
45
  nil)
 
46
 
 
47
(deftest floor.7
 
48
  (floor.7-fn)
 
49
  nil)
 
50
 
 
51
(deftest floor.8
 
52
  (floor.8-fn)
 
53
  nil)
 
54
 
 
55
(deftest floor.9
 
56
  (floor.9-fn)
 
57
  nil)
 
58
 
 
59
(deftest floor.10
 
60
  (loop for x in (remove-if #'zerop *reals*)
 
61
        for (q r) = (multiple-value-list (floor x x))
 
62
        unless (and (eql q 1)
 
63
                    (zerop r)
 
64
                    (if (rationalp x) (eql r 0)
 
65
                      (eql r (float 0 x))))
 
66
        collect x)
 
67
  nil)
 
68
 
 
69
(deftest floor.11
 
70
  (loop for x in (remove-if #'zerop *reals*)
 
71
        for (q r) = (multiple-value-list (floor (- x) x))
 
72
        unless (and (eql q -1)
 
73
                    (zerop r)
 
74
                    (if (rationalp x) (eql r 0)
 
75
                      (eql r (float 0 x))))
 
76
        collect x)
 
77
  nil)
 
78
 
 
79
(deftest floor.12
 
80
  (let* ((radix (float-radix 1.0s0))
 
81
         (rad (float radix 1.0s0))
 
82
         (rrad (/ 1.0s0 rad)))
 
83
    (loop for i from 1 to 1000
 
84
          for x = (+ i rrad)
 
85
          for (q r) = (multiple-value-list (floor x))
 
86
          unless (and (eql q i)
 
87
                      (eql r rrad))
 
88
          collect (list i x q r)))
 
89
  nil)
 
90
 
 
91
(deftest floor.13
 
92
  (let* ((radix (float-radix 1.0s0))
 
93
         (rad (float radix 1.0s0))
 
94
         (rrad (/ 1.0s0 rad)))
 
95
    (loop for i from 1 to 1000
 
96
          for x = (- i rrad)
 
97
          for (q r) = (multiple-value-list (floor x))
 
98
          unless (and (eql q (1- i))
 
99
                      (eql r rrad))
 
100
          collect (list i x q r)))
 
101
  nil)
 
102
 
 
103
(deftest floor.14
 
104
  (let* ((radix (float-radix 1.0f0))
 
105
         (rad (float radix 1.0f0))
 
106
         (rrad (/ 1.0f0 rad)))
 
107
    (loop for i from 1 to 1000
 
108
          for x = (+ i rrad)
 
109
          for (q r) = (multiple-value-list (floor x))
 
110
          unless (and (eql q i)
 
111
                      (eql r rrad))
 
112
          collect (list i x q r)))
 
113
  nil)
 
114
 
 
115
(deftest floor.15
 
116
  (let* ((radix (float-radix 1.0f0))
 
117
         (rad (float radix 1.0f0))
 
118
         (rrad (/ 1.0f0 rad)))
 
119
    (loop for i from 1 to 1000
 
120
          for x = (- i rrad)
 
121
          for (q r) = (multiple-value-list (floor x))
 
122
          unless (and (eql q (1- i))
 
123
                      (eql r rrad))
 
124
          collect (list i x q r)))
 
125
  nil)
 
126
 
 
127
(deftest floor.16
 
128
  (let* ((radix (float-radix 1.0d0))
 
129
         (rad (float radix 1.0d0))
 
130
         (rrad (/ 1.0d0 rad)))
 
131
    (loop for i from 1 to 1000
 
132
          for x = (+ i rrad)
 
133
          for (q r) = (multiple-value-list (floor x))
 
134
          unless (and (eql q i)
 
135
                      (eql r rrad))
 
136
          collect (list i x q r)))
 
137
  nil)
 
138
 
 
139
(deftest floor.17
 
140
  (let* ((radix (float-radix 1.0d0))
 
141
         (rad (float radix 1.0d0))
 
142
         (rrad (/ 1.0d0 rad)))
 
143
    (loop for i from 1 to 1000
 
144
          for x = (- i rrad)
 
145
          for (q r) = (multiple-value-list (floor x))
 
146
          unless (and (eql q (1- i))
 
147
                      (eql r rrad))
 
148
          collect (list i x q r)))
 
149
  nil)
 
150
 
 
151
(deftest floor.18
 
152
  (let* ((radix (float-radix 1.0l0))
 
153
         (rad (float radix 1.0l0))
 
154
         (rrad (/ 1.0l0 rad)))
 
155
    (loop for i from 1 to 1000
 
156
          for x = (+ i rrad)
 
157
          for (q r) = (multiple-value-list (floor x))
 
158
          unless (and (eql q i)
 
159
                      (eql r rrad))
 
160
          collect (list i x q r)))
 
161
  nil)
 
162
 
 
163
(deftest floor.19
 
164
  (let* ((radix (float-radix 1.0l0))
 
165
         (rad (float radix 1.0l0))
 
166
         (rrad (/ 1.0l0 rad)))
 
167
    (loop for i from 1 to 1000
 
168
          for x = (- i rrad)
 
169
          for (q r) = (multiple-value-list (floor x))
 
170
          unless (and (eql q (1- i))
 
171
                      (eql r rrad))
 
172
          collect (list i x q r)))
 
173
  nil)
 
174
 
 
175
;;; To add: tests that involve adding/subtracting EPSILON constants
 
176
;;; (suitably scaled) to floated integers.
 
177