subtypep-float.lsp 4.99 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Feb 15 11:55:37 2003
;;;; Contains: Tests for subtype relationships on float types

(in-package :cl-test)

;;;;;;;

(deftest subtypep.float.1
  (loop for tp in +float-types+
	append (check-subtypep tp 'float t t))
  nil)

(deftest subtypep.float.2
  (if (subtypep 'short-float 'long-float)
      (loop for tp in +float-types+
	    append
	    (loop for tp2 in +float-types+
		  append (check-subtypep tp tp2 t t)))
    nil)
  nil)

(deftest subtypep.float.3
  (if (and (not (subtypep 'short-float 'single-float))
	   (subtypep 'single-float 'long-float))
      (append
       (check-equivalence 'single-float 'double-float)
       (check-equivalence 'single-float 'long-float)
       (check-equivalence 'double-float 'long-float)
       (classes-are-disjoint 'short-float 'single-float)
       (classes-are-disjoint 'short-float 'double-float)
       (classes-are-disjoint 'short-float 'long-float))
    nil)
  nil)

(deftest subtypep.float.4
  (if (and (subtypep 'single-float 'short-float)
	   (subtypep 'double-float 'long-float)
	   (not (subtypep 'short-float 'double-float)))
      (append
       (check-equivalence 'short-float 'single-float)
       (check-equivalence 'double-float 'long-float)
       (loop for tp in '(short-float single-float)
	     append
	     (loop for tp2 in '(double-float long-float)
		   append (classes-are-disjoint tp tp2))))
    nil)
  nil)

(deftest subtypep.float.5
  (if (and (not (subtypep 'single-float 'short-float))
	   (not (subtypep 'single-float 'double-float))
	   (subtypep 'double-float 'long-float))
      (append
       (classes-are-disjoint 'short-float 'single-float)
       (classes-are-disjoint 'short-float 'double-float)
       (classes-are-disjoint 'short-float 'long-float)
       (classes-are-disjoint 'single-float 'double-float)
       (classes-are-disjoint 'single-float 'long-float)
       (check-equivalence 'double-float 'long-float))
    nil)
  nil)

(deftest subtypep.float.6
  (if (and (subtypep 'single-float 'short-float)
	   (not (subtypep 'single-float 'double-float))
	   (not (subtypep 'double-float 'long-float)))
      (append
       (check-equivalence 'short-float 'single-float)
       (classes-are-disjoint 'single-float 'double-float)
       (classes-are-disjoint 'single-float 'long-float)
       (classes-are-disjoint 'double-float 'long-float))
    nil)
  nil)

(deftest subtypep.float.7
  (if (and (not (subtypep 'single-float 'short-float))
	   (not (subtypep 'single-float 'double-float))
	   (not (subtypep 'double-float 'long-float)))
      (loop for tp in +float-types+
	    append
	    (loop for tp2 in +float-types+
		  unless (eq tp tp2)
		  append (classes-are-disjoint tp tp2)))
    nil)
  nil)

(deftest subtypep.float.8
  (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 11.0s0))
  t t)

(deftest subtypep.float.9
  (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 11.0f0))
  t t)

(deftest subtypep.float.10
  (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 11.0d0))
  t t)

(deftest subtypep.float.11
  (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 11.0l0))
  t t)

(deftest subtypep.float.12
  (subtypep* '(short-float 0.0s0 11.0s0) '(short-float 0.0s0 10.0s0))
  nil t)

(deftest subtypep.float.13
  (subtypep* '(single-float 0.0f0 11.0f0) '(single-float 0.0f0 10.0f0))
  nil t)

(deftest subtypep.float.14
  (subtypep* '(double-float 0.0d0 11.0d0) '(double-float 0.0d0 10.0d0))
  nil t)

(deftest subtypep.float.15
  (subtypep* '(long-float 0.0l0 11.0l0) '(long-float 0.0l0 10.0l0))
  nil t)

(deftest subtypep.float.16
  (subtypep* '(short-float 0.0s0 (10.0s0)) '(short-float 0.0s0 10.0s0))
  t t)

(deftest subtypep.float.17
  (subtypep* '(single-float 0.0f0 (10.0f0)) '(single-float 0.0f0 10.0f0))
  t t)

(deftest subtypep.float.18
  (subtypep* '(double-float 0.0d0 (10.0d0)) '(double-float 0.0d0 10.0d0))
  t t)

(deftest subtypep.float.19
  (subtypep* '(long-float 0.0l0 (10.0l0)) '(long-float 0.0l0 10.0l0))
  t t)

(deftest subtypep.float.20
  (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 (10.0s0)))
  nil t)

(deftest subtypep.float.21
  (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 (10.0f0)))
  nil t)

(deftest subtypep.float.22
  (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 (10.0d0)))
  nil t)

(deftest subtypep.float.23
  (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 (10.0l0)))
  nil t)

(deftest subtypep.float.24
  (check-equivalence '(and (short-float 0.0s0 2.0s0)
			   (short-float 1.0s0 3.0s0))
		     '(short-float 1.0s0 2.0s0))
  nil)

(deftest subtypep.float.25
  (check-equivalence '(and (single-float 0.0f0 2.0f0)
			   (single-float 1.0f0 3.0f0))
		     '(single-float 1.0f0 2.0f0))
  nil)

(deftest subtypep.float.26
  (check-equivalence '(and (double-float 0.0d0 2.0d0)
			   (double-float 1.0d0 3.0d0))
		     '(double-float 1.0d0 2.0d0))
  nil)

(deftest subtypep.float.27
  (check-equivalence '(and (long-float 0.0l0 2.0l0)
			   (long-float 1.0l0 3.0l0))
		     '(long-float 1.0l0 2.0l0))
  nil)