float.lsp 2.37 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Sep 11 21:53:51 2003
;;;; Contains: Tests of FLOAT

(in-package :cl-test)

(deftest float.error.1
9 10
  (signals-error (float) program-error)
  t)
11 12

(deftest float.error.2
13 14
  (signals-error (float 0 0.0 nil) program-error)
  t)
15 16 17 18 19 20

;;;

(deftest float.1
  (notnot (member (float 0) '(0.0f0 -0.0f0)))
  t)
sds's avatar
sds committed
21

22 23 24 25 26 27 28 29 30 31
(deftest float.2
  (float 1)
  1.0f0)

(deftest float.3
  (float -1)
  -1.0f0)

(deftest float.4
  (loop for i from -1000 to 1000
sds's avatar
sds committed
32 33 34 35 36
        always
        (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
              for tp in '(short-float single-float double-float long-float)
              for y = (float i x)
              always (and (= i y) (typep y tp))))
37 38 39 40
  t)

(deftest float.5
  (loop for x in *reals*
sds's avatar
sds committed
41 42
        always (or (not (floatp x))
                   (eql (float x) x)))
43 44 45 46
  t)

(deftest float.6
  (loop for x in *reals*
sds's avatar
sds committed
47 48 49 50 51 52 53
        unless (handler-case
                (or (not (typep x 'short-float))
                   (let ((y (float x 0.0f0)))
                     (and (typep y 'single-float)
                          (= x y))))
                (arithmetic-error () t))
        collect x)
54
  nil)
sds's avatar
sds committed
55

56 57
(deftest float.7
  (loop for x in *reals*
sds's avatar
sds committed
58 59 60 61 62
        unless (or (not (typep x 'short-float))
                   (let ((y (float x 0.0d0)))
                     (and (typep y 'double-float)
                          (= x y))))
        collect x)
63 64 65 66
  nil)

(deftest float.8
  (loop for x in *reals*
sds's avatar
sds committed
67 68 69 70 71
        unless (or (not (typep x 'short-float))
                   (let ((y (float x 0.0l0)))
                     (and (typep y 'long-float)
                          (= x y))))
        collect x)
72 73 74 75
  nil)

(deftest float.9
  (loop for x in *reals*
sds's avatar
sds committed
76 77 78 79 80
        unless (or (not (typep x 'single-float))
                   (let ((y (float x 0.0d0)))
                     (and (typep y 'double-float)
                          (= x y))))
        collect x)
81 82 83 84
  nil)

(deftest float.10
  (loop for x in *reals*
sds's avatar
sds committed
85 86 87 88 89
        unless (or (not (typep x 'single-float))
                   (let ((y (float x 0.0l0)))
                     (and (typep y 'long-float)
                          (= x y))))
        collect x)
90
  nil)
sds's avatar
sds committed
91

92 93
(deftest float.11
  (loop for x in *reals*
sds's avatar
sds committed
94 95 96 97 98
        unless (or (not (typep x 'double-float))
                   (let ((y (float x 0.0l0)))
                     (and (typep y 'long-float)
                          (= x y))))
        collect x)
99 100 101 102
  nil)



sds's avatar
sds committed
103