← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/fround.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/fround.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Thu Aug 21 16:07:59 2003
 
4
;;;; Contains: Tests of FROUND
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "numbers-aux.lsp")
 
9
(ignore-errors (compile-and-load "fround-aux.lsp"))
 
10
 
 
11
;;; Error tests
 
12
 
 
13
(deftest fround.error.1
 
14
  (signals-error (fround) program-error)
 
15
  t)
 
16
 
 
17
(deftest fround.error.2
 
18
  (signals-error (fround 1.0 1 nil) program-error)
 
19
  t)
 
20
 
 
21
;;; Non-error tests
 
22
 
 
23
(deftest fround.1
 
24
  (fround.1-fn)
 
25
  nil)
 
26
 
 
27
(deftest fround.10
 
28
  (loop for x in (remove-if #'zerop *reals*)
 
29
        for (q r) = (multiple-value-list (fround x x))
 
30
        unless (and (floatp q)
 
31
                    (if (floatp x)
 
32
                        (eql q (float 1 x))
 
33
                      (= q 1))
 
34
                    (zerop r)
 
35
                    (if (floatp x)
 
36
                        (eql r (float 0 x))
 
37
                      (= r 0)))
 
38
        collect x)
 
39
  nil)
 
40
 
 
41
(deftest fround.11
 
42
  (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
 
43
        for (q r) = (multiple-value-list (fround  (- x) x))
 
44
        unless (and (floatp q)
 
45
                    (if (floatp x)
 
46
                        (eql q (float -1 x))
 
47
                      (= q -1))
 
48
                    (zerop r)
 
49
                    (if (floatp x)
 
50
                        (eql r (float 0 x))
 
51
                      (= r 0)))
 
52
        collect x)
 
53
  nil)
 
54
 
 
55
(deftest fround.12
 
56
  (let* ((radix (float-radix 1.0s0))
 
57
         (rad (float radix 1.0s0))
 
58
         (rrad (/ 0.5s0 rad)))
 
59
    (loop for i from 1 to 1000
 
60
          for x = (+ i rrad)
 
61
          for (q r) = (multiple-value-list (fround x))
 
62
          unless (and (eql q (coerce i 'short-float))
 
63
                      (eql r rrad))
 
64
          collect (list i x q r)))
 
65
  nil)
 
66
 
 
67
(deftest fround.13
 
68
  (let* ((radix (float-radix 1.0s0))
 
69
         (rad (float radix 1.0s0))
 
70
         (rrad (/ 0.5s0 rad)))
 
71
    (loop for i from 1 to 1000
 
72
          for x = (- i rrad)
 
73
          for (q r) = (multiple-value-list (fround x))
 
74
          unless (and (eql q (coerce i 'short-float))
 
75
                      (eql r (- rrad)))
 
76
          collect (list i x q r)))
 
77
  nil)
 
78
 
 
79
(deftest fround.14
 
80
  (let* ((radix (float-radix 1.0f0))
 
81
         (rad (float radix 1.0f0))
 
82
         (rrad (/ 0.5f0 rad)))
 
83
    (loop for i from 1 to 1000
 
84
          for x = (+ i rrad)
 
85
          for (q r) = (multiple-value-list (fround x))
 
86
          unless (and (eql q (coerce i 'single-float))
 
87
                      (eql r rrad))
 
88
          collect (list i x q r)))
 
89
  nil)
 
90
 
 
91
(deftest fround.15
 
92
  (let* ((radix (float-radix 1.0f0))
 
93
         (rad (float radix 1.0f0))
 
94
         (rrad (/ 0.5f0 rad)))
 
95
    (loop for i from 1 to 1000
 
96
          for x = (- i rrad)
 
97
          for (q r) = (multiple-value-list (fround x))
 
98
          unless (and (eql q (coerce  i 'single-float))
 
99
                      (eql r (- rrad)))
 
100
          collect (list i x q r)))
 
101
  nil)
 
102
 
 
103
(deftest fround.16
 
104
  (let* ((radix (float-radix 1.0d0))
 
105
         (rad (float radix 1.0d0))
 
106
         (rrad (/ 0.5d0 rad)))
 
107
    (loop for i from 1 to 1000
 
108
          for x = (+ i rrad)
 
109
          for (q r) = (multiple-value-list (fround x))
 
110
          unless (and (eql q (coerce i 'double-float))
 
111
                      (eql r rrad))
 
112
          collect (list i x q r)))
 
113
  nil)
 
114
 
 
115
(deftest fround.17
 
116
  (let* ((radix (float-radix 1.0d0))
 
117
         (rad (float radix 1.0d0))
 
118
         (rrad (/ 0.5d0 rad)))
 
119
    (loop for i from 1 to 1000
 
120
          for x = (- i rrad)
 
121
          for (q r) = (multiple-value-list (fround x))
 
122
          unless (and (eql q (coerce i 'double-float))
 
123
                      (eql r (- rrad)))
 
124
          collect (list i x q r)))
 
125
  nil)
 
126
 
 
127
(deftest fround.18
 
128
  (let* ((radix (float-radix 1.0l0))
 
129
         (rad (float radix 1.0l0))
 
130
         (rrad (/ 0.5l0 rad)))
 
131
    (loop for i from 1 to 1000
 
132
          for x = (+ i rrad)
 
133
          for (q r) = (multiple-value-list (fround x))
 
134
          unless (and (eql q (coerce i 'long-float))
 
135
                      (eql r rrad))
 
136
          collect (list i x q r)))
 
137
  nil)
 
138
 
 
139
(deftest fround.19
 
140
  (let* ((radix (float-radix 1.0l0))
 
141
         (rad (float radix 1.0l0))
 
142
         (rrad (/ 0.5l0 rad)))
 
143
    (loop for i from 1 to 1000
 
144
          for x = (- i rrad)
 
145
          for (q r) = (multiple-value-list (fround x))
 
146
          unless (and (eql q (coerce i 'long-float))
 
147
                      (eql r (- rrad)))
 
148
          collect (list i x q r)))
 
149
  nil)