source: trunk/source/tests/ansi-tests/progv.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.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 12 10:00:50 2002
4;;;; Contains: Tests for PROGV
5
6(in-package :cl-test)
7
8(deftest progv.1
9  (progv () () t)
10  t)
11
12(deftest progv.2
13  (progv '(x) '(1) (not (not (boundp 'x))))
14  t)
15
16(deftest progv.3
17  (progv '(x) '(1) (symbol-value 'x))
18  1)
19
20(deftest progv.4
21  (progv '(x) '(1)
22    (locally (declare (special x))
23             x))
24  1)
25
26(deftest progv.5
27  (let ((x 0))
28    (progv '(x) '(1) x))
29  0)
30
31(deftest progv.6
32  (let ((x 0))
33    (declare (special x))
34    (progv '(x) ()
35      (boundp 'x)))
36  nil)
37
38(deftest progv.6a
39  (let ((x 0))
40    (declare (special x))
41    (progv '(x) () (setq x 1))
42    x)
43  0)
44
45(deftest progv.7
46  (progv '(x y z) '(1 2 3)
47    (locally (declare (special x y z))
48             (values x y z)))
49  1 2 3)
50
51(deftest progv.8
52  (progv '(x y z) '(1 2 3 4 5 6 7 8)
53    (locally (declare (special x y z))
54             (values x y z)))
55  1 2 3)
56
57(deftest progv.9
58  (let ((x 0))
59    (declare (special x))
60    (progv '(x y z w) '(1)
61      (values (not (not (boundp 'x)))
62              (boundp 'y)
63              (boundp 'z)
64              (boundp 'w))))
65  t nil nil nil)
66
67;; forms are evaluated in order
68
69(deftest progv.10
70  (let ((x 0) (y 0) (c 0))
71    (progv
72        (progn (setf x (incf c)) nil)
73        (progn (setf y (incf c)) nil)
74      (values x y c)))
75  1 2 2)
76
77;;; No tagbody
78
79(deftest progv.11
80  (block nil
81    (tagbody
82     (progv nil nil (go 10) 10 (return 'bad))
83     10
84     (return 'good)))
85  good)
86
87;;; Variables that are not bound don't have any type constraints
88
89(deftest progv.12
90  (progv '(x y) '(1)
91    (locally (declare  (special x y) (type nil y))
92             (values
93              x
94              (boundp 'y))))
95  1 nil)
96
97;;; Macros are expanded in the appropriate environment
98
99(deftest progv.13
100  (macrolet
101   ((%m (z) z))
102   (progv (expand-in-current-env (%m '(x)))
103          '(:good)
104          (locally (declare (special x)) x)))
105  :good)
106
107(deftest progv.14
108  (macrolet
109   ((%m (z) z))
110   (progv (list (expand-in-current-env (%m 'x)))
111          '(:good)
112          (locally (declare (special x)) x)))
113  :good)
114
115(deftest progv.15
116  (macrolet
117   ((%m (z) z))
118   (progv '(x)
119          (expand-in-current-env (%m '(:good)))
120          (locally (declare (special x)) x)))
121  :good)
122
123(deftest progv.16
124  (macrolet
125   ((%m (z) z))
126   (progv '(x)
127          (list (expand-in-current-env (%m :good)))
128          (locally (declare (special x)) x)))
129  :good)
130
131(deftest progv.17
132  (macrolet
133   ((%m (z) z))
134   (progv nil nil (expand-in-current-env (%m :good))))
135  :good)
Note: See TracBrowser for help on using the repository browser.