source: trunk/source/tests/ansi-tests/multiple-value-setq.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 19 07:00:57 2002
4;;;; Contains: Tests of MULTIPLE-VALUE-SETQ
5
6(in-package :cl-test)
7
8(deftest multiple-value-setq.1
9  (let ((x 1) (y 2))
10    (values
11     (multiple-value-list
12      (multiple-value-setq (x y) (values 3 4)))
13     x y))
14  (3) 3 4)
15
16(deftest multiple-value-setq.2
17  (let (x)
18    (multiple-value-setq (x) (values 1 2))
19    x)
20  1)
21
22(deftest multiple-value-setq.3
23  (let (x)
24    (symbol-macrolet ((y x))
25      (multiple-value-setq (y) (values 1 2))
26    x))
27  1)
28
29(deftest multiple-value-setq.4
30  (let ((x (list nil)))
31    (symbol-macrolet ((y (car x)))
32      (multiple-value-setq (y) (values 1 2))
33    x))
34  (1))
35
36;;; test of order of evaluation
37;;; The (INCF I) should be evaluated before the assigned form I.
38(deftest multiple-value-setq.5
39  (let ((i 0) (x (list nil)))
40    (symbol-macrolet ((y (car (progn (incf i) x))))
41      (multiple-value-setq (y) i))
42    x)
43  (1))
44
45(deftest multiple-value-setq.6
46  (let ((x (list nil)) z)
47    (symbol-macrolet ((y (car x)))
48      (multiple-value-setq (y z) (values 1 2)))
49    (values x z))
50  (1) 2)
51
52(deftest multiple-value-setq.7
53  (let ((x (list nil)) (z (list nil)))
54    (symbol-macrolet ((y (car x))
55                      (w (car z)))
56      (multiple-value-setq (y w) (values 1 2)))
57    (values x z))
58  (1) (2))
59
60;;; Another order of evaluation tests, this time with two
61;;; symbol macro arguments
62(deftest multiple-value-setq.8
63  (let ((x (list nil)) (z (list nil)) (i 0))
64    (symbol-macrolet ((y (car (progn (incf i 3) x)))
65                      (w (car (progn (incf i i) z))))
66      (multiple-value-setq (y w) (values i 10)))
67    (values x z))
68  (6) (10))
69
70(deftest multiple-value-setq.9
71  (let (x)
72    (values
73     (multiple-value-setq (x x) (values 1 2))
74     x))
75  1 2)
76
77(deftest multiple-value-setq.10
78  (let (x)
79    (values
80     (multiple-value-setq (x x) (values 1))
81     x))
82  1 nil)
83
84(deftest multiple-value-setq.11
85  (let ((x 1) (y 2) (z 3))
86    (multiple-value-setq (x y z) (values))
87    (values x y z))
88  nil nil nil)
89
90
91(deftest multiple-value-setq.12
92  (let ((n (min 100 multiple-values-limit))
93        (vars nil)
94        (result nil))
95    (loop
96     for i from 1 below n
97     for form =
98     (progn
99       (push (gensym) vars)
100       (push i result)
101       `(let ,vars
102          (and (eql (multiple-value-setq ,vars (values-list (quote ,result)))
103                    ,(car result))
104               (equal ,(make-list-expr vars)
105                      (quote ,result)))))
106     unless (eval form)
107     collect (list i form)))
108  nil)
109
110(deftest multiple-value-setq.13
111  (multiple-value-setq nil :good)
112  :good)
113
114(deftest multiple-value-setq.14
115  (multiple-value-setq nil (values))
116  nil)
117
118(deftest multiple-value-setq.15
119  (multiple-value-setq nil (values 'a 'b))
120  a)
121
122;;; Test that explicit calls to macroexpand in subforms
123;;; are done in the correct environment
124
125(deftest multiple-value-setq.16
126  (macrolet
127   ((%m (z) z))
128   (let ((x :bad))
129     (symbol-macrolet ((z (expand-in-current-env (%m x))))
130                      (multiple-value-setq (z) :good))
131     x))
132  :good)
133
134(deftest multiple-value-setq.17
135  (macrolet
136   ((%m (z) z))
137   (let ((x :bad))
138     (values
139      (multiple-value-setq (x) (expand-in-current-env (%m :good)))
140      x)))
141  :good :good)
142
143;;; Error tests
144
145(deftest multiple-value-setq.error.1
146  (signals-error (funcall (macro-function 'multiple-value-setq))
147                 program-error)
148  t)
149 
150(deftest multiple-value-setq.error.2
151  (signals-error (funcall (macro-function 'multiple-value-setq)
152                           '(multiple-value-setq nil nil))
153                 program-error)
154  t)
155
156(deftest multiple-value-setq.error.3
157  (signals-error (funcall (macro-function 'multiple-value-setq)
158                           '(multiple-value-setq nil nil)
159                           nil nil)
160                 program-error)
161  t)
162
163 
Note: See TracBrowser for help on using the repository browser.