the.lsp 2.34 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
;-*- 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
  (loop for e in *universe*
	for x = (multiple-value-list (eval `(the (values) (quote ,e))))
	unless (and x (not (cdr x)) (eql (car x) e))
	collect e)
  nil)

(deftest the.4
  (loop for e in *universe*
	for x = (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))
	unless (and x (not (cdr x)) (eql (car x) e))
	collect e)
  nil)
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

(deftest the.5
  (loop for e in *universe*
	for x = (multiple-value-list (eval `(the (values ,(type-of e))
					      (quote ,e))))
	unless (and x (not (cdr x)) (eql (car x) e))
	collect e)
  nil)

(deftest the.6
  (loop for e in *universe*
	for x = (multiple-value-list (eval `(the (values ,(type-of e) t)
					      (quote ,e))))
	unless (and x (not (cdr x)) (eql (car x) e))
	collect e)
  nil)

(deftest the.7
  (loop for e in *universe*
	for x = (multiple-value-list (eval `(the (values ,(type-of e))
					      (values (quote ,e) :ignored))))
	unless (and (eql (length x) 2)
		    (eql (car x) e)
		    (eql (cadr x) :ignored))
	collect e)
  nil)
pfdietz's avatar
pfdietz committed
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

(deftest the.8
  (loop for e in *universe*
	when (and (constantp e)
		  (not (eql (eval `(the ,(type-of e) ,e)) e)))
	collect e)
  nil)

(deftest the.9
  (loop for e in *universe*
	when (and (constantp e)
		  (not (eql (eval `(the ,(class-of e) ,e)) e)))
	collect e)
  nil)

(deftest the.10
  (loop for e in *universe*
	unless (eql (eval `(the ,(class-of e) ',e)) e)
	collect e)
  nil)

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
(deftest the.11
  (loop for e in *universe*
	for type = (type-of e)
	for x = (multiple-value-list (eval `(the ,type (the ,type
							 (quote ,e)))))
	unless (and x (not (cdr x)) (eql (car x) e))
	collect e)
  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
  (the (values &rest (cons t (cons t null))) (values 'a 'b))
  a b)

(deftest the.15
  (the (values &rest (cons symbol (cons symbol null))) (values 'a 'b))
  a b)

(deftest the.16
  (the (values &rest null) (values)))