source: trunk/source/tests/ansi-tests/get.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jul 13 07:01:47 2004
4;;;; Contains: Tests of GET
5
6(in-package :cl-test)
7
8(deftest get.1
9  (let ((sym (gensym))) (get sym :foo))
10  nil)
11
12(deftest get.2
13  (let ((sym (gensym))) (get sym :foo :bar))
14  :bar)
15
16(deftest get.3
17  (let ((sym (gensym))) (get sym :foo (values :bar nil)))
18  :bar)
19
20(deftest get.4
21  (let ((sym (gensym)))
22    (setf (symbol-plist sym) (list :foo 1 :bar 2 :foo 3))
23    (values (get sym :foo) (get sym :bar)))
24  1 2)
25
26(deftest get.5
27  (let ((evaluated nil)
28        (sym (gensym)))
29    (assert (equal (multiple-value-list (setf (get sym :foo) 1))
30                   '(1)))
31    (values
32     (get sym :foo (progn (setf evaluated t) nil))
33     evaluated))
34  1 t)
35
36(deftest get.6
37  (let ((evaluated nil)
38        (sym (gensym)))
39    (assert (equal (multiple-value-list
40                    (setf (get sym :foo
41                               (progn (setf evaluated t) nil))
42                          1))
43                   '(1)))
44    (values
45     (get sym :foo)
46     evaluated))
47  1 t)
48
49;;; Order of evaluation
50
51(deftest get.order.1
52  (let (a b (i 0) (sym (gensym)))
53    (setf (get sym :foo) t)
54    (values
55     (get (progn (setf a (incf i)) sym)
56          (progn (setf b (incf i)) :foo))
57     a b i))
58  t 1 2 2)
59
60(deftest get.order.2
61  (let (a b (i 0) (sym (gensym)))
62    (values
63     (setf (get (progn (setf a (incf i)) sym)
64                (progn (setf b (incf i)) :foo))
65           t)
66     a b i
67     (get sym :foo)
68     ))
69  t 1 2 2 t)
70
71(deftest get.order.3
72  (let (a b c (i 0) (sym (gensym)))
73    (setf (get sym :foo) t)
74    (values
75     (get (progn (setf a (incf i)) sym)
76          (progn (setf b (incf i)) :foo)
77          (progn (setf c (incf i)) nil))
78     a b c i))
79  t 1 2 3 3)
80
81(deftest get.order.4
82  (let (a b c (i 0) (sym (gensym)))
83    (values
84     (setf (get (progn (setf a (incf i)) sym)
85                (progn (setf b (incf i)) :foo)
86                (progn (setf c (incf i)) nil))
87           t)
88     a b c i
89     (get sym :foo)
90     ))
91  t 1 2 3 3 t)
92
93;;; Error tests
94
95(deftest get.error.1
96  (signals-error (get) program-error)
97  t)
98
99(deftest get.error.2
100  (signals-error (get nil) program-error)
101  t)
102
103(deftest get.error.3
104  (signals-error (get nil nil nil nil) program-error)
105  t)
106
107(deftest get.error.4
108  (check-type-error #'(lambda (x) (get x :foo)) #'symbolp)
109  nil)
110
111(deftest get.error.5
112  (check-type-error #'(lambda (x) (setf (get x :foo) nil)) #'symbolp)
113  nil)
Note: See TracBrowser for help on using the repository browser.