9 |
|
|
10 |
(def-macro-test defsetf.error.1 (defsetf nonexistent-access-fn |
(def-macro-test defsetf.error.1 (defsetf nonexistent-access-fn |
11 |
nonexistent-update-fn)) |
nonexistent-update-fn)) |
12 |
|
|
13 |
|
;;; Short form |
14 |
|
|
15 |
|
(defun defsetf.1-accessor (x) |
16 |
|
(cadr x)) |
17 |
|
|
18 |
|
(defun defsetf.1-accessor-settor (x val) |
19 |
|
(setf (cadr x) val)) |
20 |
|
|
21 |
|
(deftest defsetf.1 |
22 |
|
(progn |
23 |
|
(let ((vals (multiple-value-list |
24 |
|
(defsetf defsetf.1-accessor defsetf.1-accessor-settor)))) |
25 |
|
(assert (equal vals '(defsetf.1-accessor)) |
26 |
|
() |
27 |
|
"Return values are ~A~%" vals)) |
28 |
|
(let ((x (list 1 2 3))) |
29 |
|
(values |
30 |
|
(setf (defsetf.1-accessor x) 4) |
31 |
|
x))) |
32 |
|
4 |
33 |
|
(1 4 3)) |
34 |
|
|
35 |
|
;;; Use a macro instead of a function for updatefn |
36 |
|
|
37 |
|
(defun defsetf.2-accessor (x) |
38 |
|
(cadr x)) |
39 |
|
|
40 |
|
(defmacro defsetf.2-accessor-settor (x val) |
41 |
|
`(setf (cadr ,x) ,val)) |
42 |
|
|
43 |
|
(defparameter *defsetf.2-vals* |
44 |
|
(multiple-value-list |
45 |
|
(defsetf defsetf.2-accessor defsetf.2-accessor-settor))) |
46 |
|
|
47 |
|
(deftest defsetf.2a |
48 |
|
*defsetf.2-vals* |
49 |
|
(defsetf.2-accessor)) |
50 |
|
|
51 |
|
(deftest defsetf.2b |
52 |
|
(let ((x (list 1 2 3))) |
53 |
|
(values |
54 |
|
(setf (defsetf.2-accessor x) 4) |
55 |
|
x)) |
56 |
|
4 |
57 |
|
(1 4 3)) |
58 |
|
|
59 |
|
;;; Documentation string |
60 |
|
|
61 |
|
(defun defsetf.3-accessor (x) |
62 |
|
(cadr x)) |
63 |
|
|
64 |
|
(defun defsetf.3-accessor-settor (x val) |
65 |
|
(setf (cadr x) val)) |
66 |
|
|
67 |
|
(defparameter *defsetf.3-vals* |
68 |
|
(multiple-value-list |
69 |
|
(defsetf defsetf.3-accessor defsetf.3-accessor-settor |
70 |
|
"A doc string"))) |
71 |
|
|
72 |
|
(deftest defsetf.3a |
73 |
|
*defsetf.3-vals* |
74 |
|
(defsetf.3-accessor)) |
75 |
|
|
76 |
|
(deftest defsetf.3b |
77 |
|
(let ((doc (documentation 'defsetf.3-accessor 'setf))) |
78 |
|
(or (null doc) (equalt doc "A doc string"))) |
79 |
|
t) |
80 |
|
|
81 |
|
(deftest defsetf.3c |
82 |
|
(let ((x (list 1 2 3))) |
83 |
|
(values |
84 |
|
(setf (defsetf.3-accessor x) 4) |
85 |
|
x)) |
86 |
|
4 |
87 |
|
(1 4 3)) |
88 |
|
|
89 |
|
;;; Long form of defsetf |
90 |
|
|
91 |
|
(defun defsetf.4-accessor (n seq) |
92 |
|
(elt seq n)) |
93 |
|
|
94 |
|
(defparameter *defsetf.4-vals* |
95 |
|
(multiple-value-list |
96 |
|
(defsetf defsetf.4-accessor (n seq) (val) |
97 |
|
(declare) |
98 |
|
"Doc string for defsetf.4-accessor setf" |
99 |
|
`(setf (elt ,seq ,n) ,val)))) |
100 |
|
|
101 |
|
(deftest defsetf.4a |
102 |
|
*defsetf.4-vals* |
103 |
|
(defsetf.4-accessor)) |
104 |
|
|
105 |
|
(deftest defsetf.4b |
106 |
|
(let ((doc (documentation 'defsetf.4-accessor 'setf))) |
107 |
|
(or (null doc) (equalt doc "Doc string for defsetf.4-accessor setf"))) |
108 |
|
t) |
109 |
|
|
110 |
|
(deftest defsetf.4c |
111 |
|
(let ((x (list 1 2 3 4)) |
112 |
|
(i 0) |
113 |
|
(j nil) |
114 |
|
(k nil)) |
115 |
|
(values |
116 |
|
(setf (defsetf.4-accessor |
117 |
|
(progn (setf j (incf i)) |
118 |
|
2) |
119 |
|
(progn (setf k (incf i)) x)) |
120 |
|
(progn (incf i) 'a)) |
121 |
|
x |
122 |
|
i j k)) |
123 |
|
a |
124 |
|
(1 2 a 4) |
125 |
|
3 1 2) |
126 |
|
|
127 |
|
;;; Test that there's a block around the forms in long form defsetf |
128 |
|
|
129 |
|
(defun defsetf.5-accessor (x) (car x)) |
130 |
|
|
131 |
|
(defsetf defsetf.5-accessor (y) (val) |
132 |
|
(return-from defsetf.5-accessor `(setf (car ,y) ,val))) |
133 |
|
|
134 |
|
(deftest defsetf.5a |
135 |
|
(let ((x (cons 'a 'b))) |
136 |
|
(values |
137 |
|
(setf (defsetf.5-accessor x) 'c) |
138 |
|
x)) |
139 |
|
c (c . b)) |