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  (inpackage :cltest) 

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) (symbolvalue '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 (expandincurrentenv (%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 (expandincurrentenv (%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  (expandincurrentenv (%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 (expandincurrentenv (%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 (expandincurrentenv (%m :good)))) 

135  :good) 

Note: See
TracBrowser
for help on using the repository browser.