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

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  (symbolmacrolet ((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  (symbolmacrolet ((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  (symbolmacrolet ((x (aref a (incf i))) 

52  (y (aref a (incf i)))) 

53  (let ((a (copyseq #(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 (expandincurrentenv (%m 1)) 

90  y (expandincurrentenv (%m 2))) 

91  x y))) 

92  nil 1 2) 

93  

94  (deftest psetq.error.1 

95  (signalserror (funcall (macrofunction 'psetq)) programerror) 

96  t) 

97  

98  (deftest psetq.error.2 

99  (signalserror (funcall (macrofunction 'psetq) '(psetq)) 

100  programerror) 

101  t) 

102  

103  (deftest psetq.error.3 

104  (signalserror (funcall (macrofunction 'psetq) '(psetq) nil nil) 

105  programerror) 

106  t) 

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