fround.lsp 4.22 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Aug 21 16:07:59 2003
;;;; Contains: Tests of FROUND

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")
9
(compile-and-load "fround-aux.lsp")
pfdietz's avatar
pfdietz committed
10

11 12
;;; Error tests

pfdietz's avatar
pfdietz committed
13
(deftest fround.error.1
14 15
  (signals-error (fround) program-error)
  t)
pfdietz's avatar
pfdietz committed
16 17

(deftest fround.error.2
18 19
  (signals-error (fround 1.0 1 nil) program-error)
  t)
pfdietz's avatar
pfdietz committed
20

21
;;; Non-error tests
pfdietz's avatar
pfdietz committed
22 23 24 25 26 27 28

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

(deftest fround.10
  (loop for x in (remove-if #'zerop *reals*)
sds's avatar
sds committed
29 30 31 32 33 34 35 36 37 38
        for (q r) = (multiple-value-list (fround 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)
pfdietz's avatar
pfdietz committed
39 40 41 42
  nil)

(deftest fround.11
  (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
sds's avatar
sds committed
43 44 45 46 47 48 49 50 51 52
        for (q r) = (multiple-value-list (fround  (- 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)
pfdietz's avatar
pfdietz committed
53 54 55 56
  nil)

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

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

(deftest fround.14
  (let* ((radix (float-radix 1.0f0))
sds's avatar
sds committed
81 82
         (rad (float radix 1.0f0))
         (rrad (/ 0.5f0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce i 'single-float))
                      (eql r rrad))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
89 90 91 92
  nil)

(deftest fround.15
  (let* ((radix (float-radix 1.0f0))
sds's avatar
sds committed
93 94
         (rad (float radix 1.0f0))
         (rrad (/ 0.5f0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce  i 'single-float))
                      (eql r (- rrad)))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
101 102 103 104
  nil)

(deftest fround.16
  (let* ((radix (float-radix 1.0d0))
sds's avatar
sds committed
105 106
         (rad (float radix 1.0d0))
         (rrad (/ 0.5d0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce i 'double-float))
                      (eql r rrad))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
113 114 115 116
  nil)

(deftest fround.17
  (let* ((radix (float-radix 1.0d0))
sds's avatar
sds committed
117 118
         (rad (float radix 1.0d0))
         (rrad (/ 0.5d0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce i 'double-float))
                      (eql r (- rrad)))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
125 126 127 128
  nil)

(deftest fround.18
  (let* ((radix (float-radix 1.0l0))
sds's avatar
sds committed
129 130
         (rad (float radix 1.0l0))
         (rrad (/ 0.5l0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce i 'long-float))
                      (eql r rrad))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
137 138 139 140
  nil)

(deftest fround.19
  (let* ((radix (float-radix 1.0l0))
sds's avatar
sds committed
141 142
         (rad (float radix 1.0l0))
         (rrad (/ 0.5l0 rad)))
pfdietz's avatar
pfdietz committed
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 (fround x))
          unless (and (eql q (coerce i 'long-float))
                      (eql r (- rrad)))
          collect (list i x q r)))
pfdietz's avatar
pfdietz committed
149
  nil)