ffloor.lsp 4.3 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Aug 12 06:59:54 2003
;;;; Contains: Tests of FFLOOR

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")
9
(compile-and-load "ffloor-aux.lsp")
10 11

(deftest ffloor.error.1
12 13
  (signals-error (ffloor) program-error)
  t)
14 15

(deftest ffloor.error.2
16 17
  (signals-error (ffloor 1.0 1 nil) program-error)
  t)
18 19 20 21 22 23 24 25 26

;;;

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

(deftest ffloor.10
  (loop for x in (remove-if #'zerop *reals*)
sds's avatar
sds committed
27 28 29 30 31 32 33 34 35 36
        for (q r) = (multiple-value-list (ffloor x x))
        unless (and (floatp q)
                    (if (floatp x)
                        (eql q (float 1 x))
                      (= q 1))
                    (zerop r)
                    (if (floatp x)
                        (eql r (float 0 x))
                      (= r 0)))
        collect x)
37 38 39 40
  nil)

(deftest ffloor.11
  (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
sds's avatar
sds committed
41 42 43 44 45 46 47 48 49 50
        for (q r) = (multiple-value-list (ffloor  (- x) x))
        unless (and (floatp q)
                    (if (floatp x)
                        (eql q (float -1 x))
                      (= q -1))
                    (zerop r)
                    (if (floatp x)
                        (eql r (float 0 x))
                      (= r 0)))
        collect x)
51 52 53 54
  nil)

(deftest ffloor.12
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
55 56
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
57
    (loop for i from 1 to 1000
sds's avatar
sds committed
58 59 60 61 62
          for x = (+ i rrad)
          for (q r) = (multiple-value-list (ffloor x))
          unless (and (eql q (coerce i 'short-float))
                      (eql r rrad))
          collect (list i x q r)))
63 64 65 66
  nil)

(deftest ffloor.13
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
67 68
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
69
    (loop for i from 1 to 1000
sds's avatar
sds committed
70 71 72 73 74
          for x = (- i rrad)
          for (q r) = (multiple-value-list (ffloor x))
          unless (and (eql q (coerce (1- i) 'short-float))
                      (eql r rrad))
          collect (list i x q r)))
75 76 77 78
  nil)

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

(deftest ffloor.15
  (let* ((radix (float-radix 1.0f0))
sds's avatar
sds committed
91 92
         (rad (float radix 1.0f0))
         (rrad (/ 1.0f0 rad)))
93
    (loop for i from 1 to 1000
sds's avatar
sds committed
94 95 96 97 98
          for x = (- i rrad)
          for (q r) = (multiple-value-list (ffloor x))
          unless (and (eql q (coerce (1- i) 'single-float))
                      (eql r rrad))
          collect (list i x q r)))
99 100 101 102
  nil)

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

(deftest ffloor.17
  (let* ((radix (float-radix 1.0d0))
sds's avatar
sds committed
115 116
         (rad (float radix 1.0d0))
         (rrad (/ 1.0d0 rad)))
117
    (loop for i from 1 to 1000
sds's avatar
sds committed
118 119 120 121 122
          for x = (- i rrad)
          for (q r) = (multiple-value-list (ffloor x))
          unless (and (eql q (coerce (1- i) 'double-float))
                      (eql r rrad))
          collect (list i x q r)))
123 124 125 126
  nil)

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

(deftest ffloor.19
  (let* ((radix (float-radix 1.0l0))
sds's avatar
sds committed
139 140
         (rad (float radix 1.0l0))
         (rrad (/ 1.0l0 rad)))
141
    (loop for i from 1 to 1000
sds's avatar
sds committed
142 143 144 145 146
          for x = (- i rrad)
          for (q r) = (multiple-value-list (ffloor x))
          unless (and (eql q (coerce (1- i) 'long-float))
                      (eql r rrad))
          collect (list i x q r)))
147 148 149 150
  nil)

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