source: trunk/source/tests/ansi-tests/psetq.lsp @ 8991

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

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

File size: 2.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 15:37:20 2003
4;;;; Contains: Tests of PSETQ
5
6(in-package :cl-test)
7
8(deftest psetq.1
9  (psetq)
10  nil)
11
12(deftest psetq.2
13  (let ((x 0))
14    (values (psetq x 1) x))
15  nil 1)
16
17(deftest psetq.3
18  (let ((x 0) (y 1))
19    (values (psetq x y y x) x y))
20  nil 1 0)
21
22(deftest psetq.4
23  (let ((x 0))
24    (values
25     (symbol-macrolet ((x y))
26       (let ((y 1))
27         (psetq x 2)
28         y))
29     x))
30  2 0)
31
32(deftest psetq.5
33  (let ((w (list nil)))
34    (values
35     (symbol-macrolet ((x (car w)))
36       (psetq x 2))
37     w))
38  nil (2))
39
40(deftest psetq.6
41  (let ((c 0) x y)
42    (psetq x (incf c)
43           y (incf c))
44    (values c x y))
45  2 1 2)
46
47;;; The next test is a PSETQ that is equivalent to a PSETF
48;;; See PSETF.7 for comments related to this test.
49
50(deftest psetq.7
51  (symbol-macrolet ((x (aref a (incf i)))
52                    (y (aref a (incf i))))
53    (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9)))
54          (i 0))
55      (psetq x (aref a (incf i))
56             y (aref a (incf i)))
57      (values a i)))
58  #(0 2 2 4 4 5 6 7 8 9)
59  4)
60
61(deftest psetq.8
62  (let ((*x* 0) (*y* 10))
63    (declare (special *x* *y*))
64    (values
65     *x* *y*
66     (psetq *x* 6
67            *y* 15)
68     *x* *y*))
69  0 10 nil 6 15)
70
71(deftest psetq.9
72  (let ((*x* 0) (*y* 10))
73    (declare (special *x* *y*))
74    (values
75     *x* *y*
76     (psetq *x* *y*
77            *y* *x*)
78     *x* *y*))
79  0 10 nil 10 0)
80
81;;; Test that explicit calls to macroexpand in subforms
82;;; are done in the correct environment
83
84(deftest psetq.10
85  (macrolet
86   ((%m (z) z))
87   (let ((x nil) (y nil))
88     (values
89      (psetq x (expand-in-current-env (%m 1))
90             y (expand-in-current-env (%m 2)))
91      x y)))
92  nil 1 2)
93
94(deftest psetq.error.1
95  (signals-error (funcall (macro-function 'psetq)) program-error)
96  t)
97
98(deftest psetq.error.2
99  (signals-error (funcall (macro-function 'psetq) '(psetq))
100                 program-error)
101  t)
102
103(deftest psetq.error.3
104  (signals-error (funcall (macro-function 'psetq) '(psetq) nil nil)
105                 program-error)
106  t)
Note: See TracBrowser for help on using the repository browser.