the.lsp 3.25 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue May  6 06:48:48 2003
;;;; Contains: Tests of THE

(in-package :cl-test)

(deftest the.1
  (the (values) (values)))

(deftest the.2
  (the (values) 'a)
  a)

(deftest the.3
16
17
18
  (check-predicate #'(lambda (e)
		       (let ((x (multiple-value-list (eval `(the (values) (quote ,e))))))
			 (and x (not (cdr x)) (eql (car x) e)))))
19
20
21
  nil)

(deftest the.4
22
23
24
  (check-predicate #'(lambda (e)
		       (let ((x (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))))
			 (and x (not (cdr x)) (eql (car x) e)))))
25
  nil)
26
27

(deftest the.5
28
29
30
  (check-predicate #'(lambda (e)
		       (let ((x (multiple-value-list (eval `(the (values ,(type-of e)) (quote ,e))))))
			 (and x (not (cdr x)) (eql (car x) e)))))
31
32
33
  nil)

(deftest the.6
34
35
36
  (check-predicate #'(lambda (e)
		       (let ((x (multiple-value-list (eval `(the (values ,(type-of e) t) (quote ,e))))))
			 (and x (not (cdr x)) (eql (car x) e)))))
37
38
39
  nil)

(deftest the.7
40
41
42
43
44
45
46
  (check-predicate
   #'(lambda (e)
       (let ((x (multiple-value-list (eval `(the (values ,(type-of e))
					      (values (quote ,e) :ignored))))))
	 (and (eql (length x) 2)
	      (eql (car x) e)
	      (eql (cadr x) :ignored)))))
47
  nil)
pfdietz's avatar
pfdietz committed
48
49

(deftest the.8
50
51
  (check-predicate #'(lambda (e) (or (not (constantp e))
				     (eql (eval `(the ,(type-of e) ,e)) e))))
pfdietz's avatar
pfdietz committed
52
53
54
  nil)

(deftest the.9
55
56
  (check-predicate #'(lambda (e) (or (not (constantp e))
				     (eql (eval `(the ,(class-of e) ,e)) e))))
pfdietz's avatar
pfdietz committed
57
58
59
  nil)

(deftest the.10
60
  (check-predicate #'(lambda (e) (eql (eval `(the ,(class-of e) ',e)) e)))
pfdietz's avatar
pfdietz committed
61
62
  nil)

63
(deftest the.11
64
65
66
67
68
  (check-predicate
   #'(lambda (e)
       (let* ((type (type-of e))
	      (x (multiple-value-list (eval `(the ,type (the ,type (quote ,e)))))))
	 (and x (not (cdr x)) (eql (car x) e)))))
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
  nil)

(deftest the.12
  (let ((lexpr
	 `(lambda ()
	    (and
	     ,@(loop for e in *mini-universe*
		     for type = (type-of e)
		     collect `(eqlt (quote ,e) (the ,type (quote ,e))))))))
    (funcall (compile nil lexpr)))
  t)

(deftest the.13
  (let ((x 0))
    (values
     (the (or symbol integer) (incf x))
     x))
  1 1)

(deftest the.14
89
  (the (values &rest t) (values 'a 'b))
90
91
92
  a b)

(deftest the.15
93
  (the (values &rest symbol) (values 'a 'b))
94
95
96
97
  a b)

(deftest the.16
  (the (values &rest null) (values)))
98
99
100
101
102
103
104
105

(deftest the.17
  (the (values symbol integer &rest null) (values 'a 1))
  a 1)

(deftest the.18
  (the (values symbol integer &rest t) (values 'a 1 'foo '(x y)))
  a 1 foo (x y))
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

(deftest the.19
  (let () (list (the (values) (eval '(values)))))
  (nil))

;;; This is from SBCL bug 261
(deftest the.20
  (let () (list (the (values &optional fixnum) (eval '(values)))))
  (nil))

(deftest the.21
  (let () (list (the (values &rest t) (eval '(values)))))
  (nil))

(deftest the.22
  (the (values symbol integer &rest t) (eval '(values 'a 1 'foo '(x y))))
  a 1 foo (x y))

(deftest the.23
  (multiple-value-list
   (the (values symbol integer &optional fixnum) (eval '(values 'a 1))))
  (a 1))

129
130
131
132
133
134
135
136
137
138
139
140
141
142
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest the.24
  (macrolet
   ((%m (z) z))
   (the (integer 0 10) (expand-in-current-env (%m 4))))
  4)

(deftest the.25
  (macrolet
   ((%m (z) z))
   (the (values t t) (expand-in-current-env (%m (values 1 2)))))
  1 2)
143