ftruncate.lsp 4.41 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Aug 20 06:36:35 2003
;;;; Contains: Tests of FTRUNCATE

(in-package :cl-test)

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

11 12
;;; Error tests

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

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

21
;;; Non-error tests
22 23 24 25 26 27 28

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

(deftest ftruncate.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 (ftruncate 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)
39 40 41 42
  nil)

(deftest ftruncate.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 (ftruncate  (- 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)
53 54 55 56
  nil)

(deftest ftruncate.12
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
57 58
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
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 (ftruncate x))
          unless (and (eql q (coerce i 'short-float))
                      (eql r rrad))
          collect (list i x q r)))
65 66 67 68
  nil)

(deftest ftruncate.13
  (let* ((radix (float-radix 1.0s0))
sds's avatar
sds committed
69 70
         (rad (float radix 1.0s0))
         (rrad (/ 1.0s0 rad)))
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 (ftruncate x))
          unless (and (eql q (coerce (1- i) 'short-float))
                      (eql r rrad))
          collect (list i x q r)))
77 78 79 80
  nil)

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

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

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

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

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

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

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