floor.lsp 4.18 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Aug  4 22:16:00 2003
;;;; Contains: Tests of FLOOR

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")
(compile-and-load "floor-aux.lsp")

11 12
;;; Error tests

13
(deftest floor.error.1
14 15
  (signals-error (floor) program-error)
  t)
16 17

(deftest floor.error.2
18 19
  (signals-error (floor 1.0 1 nil) program-error)
  t)
20

21
;;; Non-error tests
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60

(deftest floor.1
  (floor.1-fn)
  nil)

(deftest floor.2
  (floor.2-fn)
  nil)

(deftest floor.3
  (floor.3-fn 2.0s4)
  nil)

(deftest floor.4
  (floor.3-fn 2.0f4)
  nil)

(deftest floor.5
  (floor.3-fn 2.0d4)
  nil)

(deftest floor.6
  (floor.3-fn 2.0l4)
  nil)

(deftest floor.7
  (floor.7-fn)
  nil)

(deftest floor.8
  (floor.8-fn)
  nil)

(deftest floor.9
  (floor.9-fn)
  nil)

(deftest floor.10
  (loop for x in (remove-if #'zerop *reals*)
sds's avatar
sds committed
61 62 63 64 65 66
        for (q r) = (multiple-value-list (floor x x))
        unless (and (eql q 1)
                    (zerop r)
                    (if (rationalp x) (eql r 0)
                      (eql r (float 0 x))))
        collect x)
67 68 69 70
  nil)

(deftest floor.11
  (loop for x in (remove-if #'zerop *reals*)
sds's avatar
sds committed
71 72 73 74 75 76
        for (q r) = (multiple-value-list (floor (- x) x))
        unless (and (eql q -1)
                    (zerop r)
                    (if (rationalp x) (eql r 0)
                      (eql r (float 0 x))))
        collect x)
77 78
  nil)

79 80
(deftest floor.12
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
81 82
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
83
    (loop for i from 1 to 1000
sds's avatar
sds committed
84 85 86 87 88
          for x = (+ i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q i)
                      (eql r rrad))
          collect (list i x q r)))
89 90 91 92
  nil)

(deftest floor.13
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
93 94
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
95
    (loop for i from 1 to 1000
sds's avatar
sds committed
96 97 98 99 100
          for x = (- i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q (1- i))
                      (eql r rrad))
          collect (list i x q r)))
101 102 103 104
  nil)

(deftest floor.14
  (let* ((radix (float-radix 1.0f0))
sds's avatar
sds committed
105 106
         (rad (float radix 1.0f0))
         (rrad (/ 1.0f0 rad)))
107
    (loop for i from 1 to 1000
sds's avatar
sds committed
108 109 110 111 112
          for x = (+ i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q i)
                      (eql r rrad))
          collect (list i x q r)))
113 114 115 116
  nil)

(deftest floor.15
  (let* ((radix (float-radix 1.0f0))
sds's avatar
sds committed
117 118
         (rad (float radix 1.0f0))
         (rrad (/ 1.0f0 rad)))
119
    (loop for i from 1 to 1000
sds's avatar
sds committed
120 121 122 123 124
          for x = (- i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q (1- i))
                      (eql r rrad))
          collect (list i x q r)))
125 126 127 128
  nil)

(deftest floor.16
  (let* ((radix (float-radix 1.0d0))
sds's avatar
sds committed
129 130
         (rad (float radix 1.0d0))
         (rrad (/ 1.0d0 rad)))
131
    (loop for i from 1 to 1000
sds's avatar
sds committed
132 133 134 135 136
          for x = (+ i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q i)
                      (eql r rrad))
          collect (list i x q r)))
137 138 139 140
  nil)

(deftest floor.17
  (let* ((radix (float-radix 1.0d0))
sds's avatar
sds committed
141 142
         (rad (float radix 1.0d0))
         (rrad (/ 1.0d0 rad)))
143
    (loop for i from 1 to 1000
sds's avatar
sds committed
144 145 146 147 148
          for x = (- i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q (1- i))
                      (eql r rrad))
          collect (list i x q r)))
149 150 151 152
  nil)

(deftest floor.18
  (let* ((radix (float-radix 1.0l0))
sds's avatar
sds committed
153 154
         (rad (float radix 1.0l0))
         (rrad (/ 1.0l0 rad)))
155
    (loop for i from 1 to 1000
sds's avatar
sds committed
156 157 158 159 160
          for x = (+ i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q i)
                      (eql r rrad))
          collect (list i x q r)))
161 162 163 164
  nil)

(deftest floor.19
  (let* ((radix (float-radix 1.0l0))
sds's avatar
sds committed
165 166
         (rad (float radix 1.0l0))
         (rrad (/ 1.0l0 rad)))
167
    (loop for i from 1 to 1000
sds's avatar
sds committed
168 169 170 171 172
          for x = (- i rrad)
          for (q r) = (multiple-value-list (floor x))
          unless (and (eql q (1- i))
                      (eql r rrad))
          collect (list i x q r)))
173 174 175 176 177
  nil)

;;; To add: tests that involve adding/subtracting EPSILON constants
;;; (suitably scaled) to floated integers.