(cl-eval-when (compile eval load)
(defconst comp-tests-type-spec-tests
- `(
+ '(
;; 1
((defun comp-tests-ret-type-spec-f (x)
x)
- t)
+ 't)
;; 2
((defun comp-tests-ret-type-spec-f ()
1)
- (integer 1 1))
+ '(integer 1 1))
;; 3
((defun comp-tests-ret-type-spec-f (x)
(if x 1 3))
- (or (integer 1 1) (integer 3 3)))
+ '(or (integer 1 1) (integer 3 3)))
;; 4
((defun comp-tests-ret-type-spec-f (x)
(setf y 1)
(setf y 2))
y))
- (integer 1 2))
+ '(integer 1 2))
;; 5
((defun comp-tests-ret-type-spec-f (x)
(setf y 1)
(setf y 3))
y))
- (or (integer 1 1) (integer 3 3)))
+ '(or (integer 1 1) (integer 3 3)))
;; 6
((defun comp-tests-ret-type-spec-f (x)
(if x
(list x)
3))
- (or cons (integer 3 3)))
+ '(or cons (integer 3 3)))
;; 7
((defun comp-tests-ret-type-spec-f (x)
(if x
'foo
3))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 8
((defun comp-tests-ret-type-spec-f (x)
(if (eq x 3)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 9
((defun comp-tests-ret-type-spec-f (x)
(if (eq 3 x)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 10
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 3)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 11
((defun comp-tests-ret-type-spec-f (x)
(if (eql 3 x)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 12
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 3)
'foo
x))
- (not (integer 3 3)))
+ '(not (integer 3 3)))
;; 13
((defun comp-tests-ret-type-spec-f (x y)
(if (= x y)
x
'foo))
- (or (member foo) marker number))
+ '(or (member foo) marker number))
;; 14
((defun comp-tests-ret-type-spec-f (x)
(comp-hint-fixnum x))
- (integer ,most-negative-fixnum ,most-positive-fixnum))
+ `(integer ,most-negative-fixnum ,most-positive-fixnum))
;; 15
((defun comp-tests-ret-type-spec-f (x)
(comp-hint-cons x))
- cons)
+ 'cons)
;; 16
((defun comp-tests-ret-type-spec-f (x)
(when x
(setf y 4))
y))
- (or null (integer 4 4)))
+ '(or null (integer 4 4)))
;; 17
((defun comp-tests-ret-type-spec-f ()
(y 3))
(setf x y)
y))
- (integer 3 3))
+ '(integer 3 3))
;; 18
((defun comp-tests-ret-type-spec-f (x)
(when x
(setf y x))
y))
- t)
+ 't)
;; 19
((defun comp-tests-ret-type-spec-f (x y)
(eq x y))
- boolean)
+ 'boolean)
;; 20
((defun comp-tests-ret-type-spec-f (x)
(when x
'foo))
- (or (member foo) null))
+ '(or (member foo) null))
;; 21
((defun comp-tests-ret-type-spec-f (x)
(unless x
'foo))
- (or (member foo) null))
+ '(or (member foo) null))
;; 22
((defun comp-tests-ret-type-spec-f (x)
(when (> x 3)
x))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 23
((defun comp-tests-ret-type-spec-f (x)
(when (>= x 3)
x))
- (or null float (integer 3 *)))
+ '(or null float (integer 3 *)))
;; 24
((defun comp-tests-ret-type-spec-f (x)
(when (< x 3)
x))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 25
((defun comp-tests-ret-type-spec-f (x)
(when (<= x 3)
x))
- (or null float (integer * 3)))
+ '(or null float (integer * 3)))
;; 26
((defun comp-tests-ret-type-spec-f (x)
(when (> 3 x)
x))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 27
((defun comp-tests-ret-type-spec-f (x)
(when (>= 3 x)
x))
- (or null float (integer * 3)))
+ '(or null float (integer * 3)))
;; 28
((defun comp-tests-ret-type-spec-f (x)
(when (< 3 x)
x))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 29
((defun comp-tests-ret-type-spec-f (x)
(when (<= 3 x)
x))
- (or null float (integer 3 *)))
+ '(or null float (integer 3 *)))
;; 30
((defun comp-tests-ret-type-spec-f (x)
(let ((y 3))
(when (> x y)
x)))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 31
((defun comp-tests-ret-type-spec-f (x)
(let ((y 3))
(when (> y x)
x)))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 32
((defun comp-tests-ret-type-spec-f (x)
(when (and (> x 3)
(< x 10))
x))
- (or null float (integer 4 9)))
+ '(or null float (integer 4 9)))
;; 33
((defun comp-tests-ret-type-spec-f (x)
(when (or (> x 3)
(< x 10))
x))
- (or null float integer))
+ '(or null float integer))
;; 34
((defun comp-tests-ret-type-spec-f (x)
(when (or (< x 3)
(> x 10))
x))
- (or null float (integer * 2) (integer 11 *)))
+ '(or null float (integer * 2) (integer 11 *)))
;; 35 No float range support.
((defun comp-tests-ret-type-spec-f (x)
(when (> x 1.0)
x))
- (or null marker number))
+ '(or null marker number))
;; 36
((defun comp-tests-ret-type-spec-f (x y)
(when (and (> x 3)
(> y 2))
(+ x y)))
- (or null float (integer 7 *)))
+ '(or null float (integer 7 *)))
;; 37
;; SBCL: (OR REAL NULL)
(when (and (<= x 3)
(<= y 2))
(+ x y)))
- (or null float (integer * 5)))
+ '(or null float (integer * 5)))
;; 38
((defun comp-tests-ret-type-spec-f (x y)
(when (and (< 1 x 5)
(< 1 y 5))
(+ x y)))
- (or null float (integer 4 8)))
+ '(or null float (integer 4 8)))
;; 39
;; SBCL gives: (OR REAL NULL)
(when (and (<= 1 x 10)
(<= 2 y 3))
(+ x y)))
- (or null float (integer 3 13)))
+ '(or null float (integer 3 13)))
;; 40
;; SBCL: (OR REAL NULL)
(when (and (<= 1 x 10)
(<= 2 y 3))
(- x y)))
- (or null float (integer -2 8)))
+ '(or null float (integer -2 8)))
;; 41
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 1 x)
(<= 2 y 3))
(- x y)))
- (or null float (integer -2 *)))
+ '(or null float (integer -2 *)))
;; 42
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 1 x 10)
(<= 2 y))
(- x y)))
- (or null float (integer * 8)))
+ '(or null float (integer * 8)))
;; 43
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= x 10)
(<= 2 y))
(- x y)))
- (or null float (integer * 8)))
+ '(or null float (integer * 8)))
;; 44
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= x 10)
(<= y 3))
(- x y)))
- (or null float integer))
+ '(or null float integer))
;; 45
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 2 x)
(<= 3 y))
(- x y)))
- (or null float integer))
+ '(or null float integer))
;; 46
;; SBCL: (OR (RATIONAL (6) (30)) (SINGLE-FLOAT 6.0 30.0)
(< 1 j 5)
(< 1 k 5))
(+ x y z i j k)))
- (or null float (integer 12 24)))
+ '(or null float (integer 12 24)))
;; 47
((defun comp-tests-ret-type-spec-f (x)
(when (<= 1 x 5)
(1+ x)))
- (or null float (integer 2 6)))
+ '(or null float (integer 2 6)))
;;48
((defun comp-tests-ret-type-spec-f (x)
(when (<= 1 x 5)
(1- x)))
- (or null float (integer 0 4)))
+ '(or null float (integer 0 4)))
;; 49
((defun comp-tests-ret-type-spec-f ()
(error "Foo"))
- nil)
+ 'nil)
;; 50
((defun comp-tests-ret-type-spec-f (x)
(if (stringp x)
x
'bar))
- (or (member bar) string))
+ '(or (member bar) string))
;; 51
((defun comp-tests-ret-type-spec-f (x)
(if (stringp x)
'bar
x))
- (not string))
+ '(not string))
;; 52
((defun comp-tests-ret-type-spec-f (x)
(if (integerp x)
x
'bar))
- (or (member bar) integer))
+ '(or (member bar) integer))
;; 53
((defun comp-tests-ret-type-spec-f (x)
(when (integerp x)
x))
- (or null integer))
+ '(or null integer))
;; 54
((defun comp-tests-ret-type-spec-f (x)
(unless (symbolp x)
x))
- t)
+ 't)
;; 55
((defun comp-tests-ret-type-spec-f (x)
(unless (integerp x)
x))
- (not integer))
+ '(not integer))
;; 56
((defun comp-tests-ret-type-spec-f (x)
(1 (message "one"))
(5 (message "five")))
x)
- t
+ 't
;; FIXME improve `comp-cond-cstrs-target-mvar' to cross block
;; boundary if necessary as this should return:
;; (or (integer 1 1) (integer 5 5))
(eql x 3))
(error "Not foo or 3"))
x)
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;;58
((defun comp-tests-ret-type-spec-f (x y)
(<= x y))
x
(error "")))
- (integer 0 *))
+ '(integer 0 *))
;; 59
((defun comp-tests-ret-type-spec-f (x y)
(<= x y))
x
(error "")))
- (or float (integer 3 10)))
+ '(or float (integer 3 10)))
;; 60
((defun comp-tests-ret-type-spec-f (x y)
(>= x y))
x
(error "")))
- (or float (integer 3 10)))
+ '(or float (integer 3 10)))
;; 61
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.0)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 62
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.0)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 63
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.1)
x
(error "")))
- (member 1.1))
+ '(member 1.1))
;; 64
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 65
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 66
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 0.0)
x
(error "")))
- float)
+ 'float)
;; 67
((defun comp-tests-ret-type-spec-f (x)
(if (equal x '(1 2 3))
x
(error "")))
- cons)
+ 'cons)
;; 68
((defun comp-tests-ret-type-spec-f (x)
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 69
((defun comp-tests-ret-type-spec-f (x)
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 70
((defun comp-tests-ret-type-spec-f (x y)
(= x y))
x
(error "")))
- (or float integer))
+ '(or float integer))
;; 71
((defun comp-tests-ret-type-spec-f (x)
(if (= x 0.0)
x
(error "")))
- (or (member -0.0 0.0) (integer 0 0)))
+ '(or (member -0.0 0.0) (integer 0 0)))
;; 72
((defun comp-tests-ret-type-spec-f (x)
(unless (eql x -0.0)
(error ""))
x)
- float)
+ 'float)
;; 73
((defun comp-tests-ret-type-spec-f (x)
(when (eql x 1.0)
(error ""))
x)
- t)
+ 't)
;; 74
((defun comp-tests-ret-type-spec-f (x)
(if (eq x 0)
(error "")
(1+ x)))
- number)))
+ 'number)))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
,(format "Type specifier test number %d." number)
(let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-tests-check-ret-type-spec ',(car x) ',(cadr x))))))
+ (comp-tests-check-ret-type-spec ',(car x) ,(cadr x))))))
(defmacro comp-tests-define-type-spec-tests ()
"Define all type specifier tests."
(equal (comp-mvar-typeset mvar)
comp-tests-cond-rw-expected-type))))))))
-;; We don't want to byte compile this to avoid recording in the
-;; bytecode the architecture-dependent values of most-positive-fixnum
-;; and most-negative-fixnum, thus making the byte-compiled file
-;; non-portable.
-
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
;;; comp-tests.el ends here