← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/the.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/the.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Tue May  6 06:48:48 2003
 
4
;;;; Contains: Tests of THE
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest the.1
 
9
  (the (values) (values)))
 
10
 
 
11
(deftest the.2
 
12
  (the (values) 'a)
 
13
  a)
 
14
 
 
15
(deftest the.3
 
16
  (loop for e in *universe*
 
17
        for x = (multiple-value-list (eval `(the (values) (quote ,e))))
 
18
        unless (and x (not (cdr x)) (eql (car x) e))
 
19
        collect e)
 
20
  nil)
 
21
 
 
22
(deftest the.4
 
23
  (loop for e in *universe*
 
24
        for x = (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))
 
25
        unless (and x (not (cdr x)) (eql (car x) e))
 
26
        collect e)
 
27
  nil)
 
28
 
 
29
(deftest the.5
 
30
  (loop for e in *universe*
 
31
        for x = (multiple-value-list (eval `(the (values ,(type-of e))
 
32
                                              (quote ,e))))
 
33
        unless (and x (not (cdr x)) (eql (car x) e))
 
34
        collect e)
 
35
  nil)
 
36
 
 
37
(deftest the.6
 
38
  (loop for e in *universe*
 
39
        for x = (multiple-value-list (eval `(the (values ,(type-of e) t)
 
40
                                              (quote ,e))))
 
41
        unless (and x (not (cdr x)) (eql (car x) e))
 
42
        collect e)
 
43
  nil)
 
44
 
 
45
(deftest the.7
 
46
  (loop for e in *universe*
 
47
        for x = (multiple-value-list (eval `(the (values ,(type-of e))
 
48
                                              (values (quote ,e) :ignored))))
 
49
        unless (and (eql (length x) 2)
 
50
                    (eql (car x) e)
 
51
                    (eql (cadr x) :ignored))
 
52
        collect e)
 
53
  nil)
 
54
 
 
55
(deftest the.8
 
56
  (loop for e in *universe*
 
57
        when (and (constantp e)
 
58
                  (not (eql (eval `(the ,(type-of e) ,e)) e)))
 
59
        collect e)
 
60
  nil)
 
61
 
 
62
(deftest the.9
 
63
  (loop for e in *universe*
 
64
        when (and (constantp e)
 
65
                  (not (eql (eval `(the ,(class-of e) ,e)) e)))
 
66
        collect e)
 
67
  nil)
 
68
 
 
69
(deftest the.10
 
70
  (loop for e in *universe*
 
71
        unless (eql (eval `(the ,(class-of e) ',e)) e)
 
72
        collect e)
 
73
  nil)
 
74
 
 
75
(deftest the.11
 
76
  (loop for e in *universe*
 
77
        for type = (type-of e)
 
78
        for x = (multiple-value-list (eval `(the ,type (the ,type
 
79
                                                         (quote ,e)))))
 
80
        unless (and x (not (cdr x)) (eql (car x) e))
 
81
        collect e)
 
82
  nil)
 
83
 
 
84
(deftest the.12
 
85
  (let ((lexpr
 
86
         `(lambda ()
 
87
            (and
 
88
             ,@(loop for e in *mini-universe*
 
89
                     for type = (type-of e)
 
90
                     collect `(eqlt (quote ,e) (the ,type (quote ,e))))))))
 
91
    (funcall (compile nil lexpr)))
 
92
  t)
 
93
 
 
94
(deftest the.13
 
95
  (let ((x 0))
 
96
    (values
 
97
     (the (or symbol integer) (incf x))
 
98
     x))
 
99
  1 1)
 
100
 
 
101
(deftest the.14
 
102
  (the (values &rest t) (values 'a 'b))
 
103
  a b)
 
104
 
 
105
(deftest the.15
 
106
  (the (values &rest symbol) (values 'a 'b))
 
107
  a b)
 
108
 
 
109
(deftest the.16
 
110
  (the (values &rest null) (values)))
 
111
 
 
112
(deftest the.17
 
113
  (the (values symbol integer &rest null) (values 'a 1))
 
114
  a 1)
 
115
 
 
116
(deftest the.18
 
117
  (the (values symbol integer &rest t) (values 'a 1 'foo '(x y)))
 
118
  a 1 foo (x y))
 
119
 
 
120
(deftest the.19
 
121
  (let () (list (the (values) (eval '(values)))))
 
122
  (nil))
 
123
 
 
124
;;; This is from SBCL bug 261
 
125
(deftest the.20
 
126
  (let () (list (the (values &optional fixnum) (eval '(values)))))
 
127
  (nil))
 
128
 
 
129
(deftest the.21
 
130
  (let () (list (the (values &rest t) (eval '(values)))))
 
131
  (nil))
 
132
 
 
133
(deftest the.22
 
134
  (the (values symbol integer &rest t) (eval '(values 'a 1 'foo '(x y))))
 
135
  a 1 foo (x y))
 
136
 
 
137
(deftest the.23
 
138
  (multiple-value-list
 
139
   (the (values symbol integer &optional fixnum) (eval '(values 'a 1))))
 
140
  (a 1))
 
141
 
 
142