src/method-proto.lisp (invoke-delegation-chain): Pass keyword args correctly.
[sod] / test / test.sod
1 /* -*-sod-*- */
2
3 code h : includes {
4 #include "sod.h"
5 }
6
7 code c : includes {
8 #include <stdio.h>
9 #include <stdlib.h>
10 #include <string.h>
11
12 #include "test.h"
13 }
14
15 code c : early_user {
16 /*----- Preliminary definitions -------------------------------------------*/
17
18 /* Confuse the fragment scanner... */
19 #define LBRACE {
20 #define RBRACE }
21
22 static const char *test_name;
23 static int test_seq;
24
25 static void prepare(const char *name) { test_name = name; test_seq = 0; }
26
27 static void step(int q, const char *where)
28 {
29 if (test_seq != q) {
30 fprintf(stderr, "test %s (%s): step %d instead of %d\n",
31 test_name, where, q, test_seq);
32 abort();
33 }
34 test_seq++;
35 }
36
37 static void done(int q, const char *where) { step(q, where); }
38
39 #define STRINGIFY_(x) #x
40 #define STRINGIFY(x) STRINGIFY_(x)
41 #define WHERE __FILE__ ":" STRINGIFY(__LINE__)
42 #define STEP(q) step((q), WHERE)
43 #define DONE(q) done((q), WHERE)
44
45 }
46
47 code c : (tests head)
48 [user (tests head) tests (tests tail) main (user end)]
49 {
50 /*----- Test machinery ----------------------------------------------------*/
51
52 static void tests(void)
53 LBRACE
54 }
55 code c : (tests tail) {
56 RBRACE
57
58 }
59
60 code c : main {
61 /*----- Main program ------------------------------------------------------*/
62
63 int main(void)
64 {
65 tests();
66 return (0);
67 }
68
69 }
70
71 /*----- Various kinds of method combinations ------------------------------*/
72
73 code h : early_user {
74 struct item {
75 struct item *next;
76 const char *p;
77 };
78
79 }
80
81 code c : early_user {
82 static void *xmalloc(size_t n)
83 {
84 void *p = malloc(n);
85 if (!p) { perror("malloc"); exit(EXIT_FAILURE); }
86 return (p);
87 }
88
89 static struct item *make_item(const char *p)
90 { struct item *q = xmalloc(sizeof(*q)); q->p = p; return (q); }
91
92 static void free_list(struct item *i)
93 { struct item *ii; while (i) { ii = i->next; free(i); i = ii; } }
94
95 static int check_list(struct item *i, ...)
96 {
97 va_list ap;
98 const char *p;
99 int rc = -1;
100
101 va_start(ap, i);
102 for (;;) {
103 p = va_arg(ap, const char *);
104 if (!p) break;
105 if (!i || strcmp(i->p, p) != 0) break;
106 i = i->next;
107 }
108 if (!i) rc = 0;
109 va_end(ap);
110 return (rc);
111 }
112
113 struct vec { int *v; size_t n; };
114
115 static void free_vec(struct vec *v) { free(v->v); }
116
117 static int check_vec(struct vec *v, ...)
118 {
119 va_list ap;
120 int j;
121 size_t i = 0;
122 int rc = -1;
123
124 va_start(ap, v);
125 for (;;) {
126 j = va_arg(ap, int);
127 if (j < 0) break;
128 if (i == v->n || j != v->v[i]) break;
129 i++;
130 }
131 if (i == v->n) rc = 0;
132 va_end(ap);
133 return (rc);
134 }
135
136 }
137
138 [link = SodObject, nick = t1base]
139 class T1Base : SodObject {
140 [combination = progn] void aprogn() { STEP(1); }
141 [combination = sum] int asum() { return 1; }
142 [combination = and] int aand() { return 8; }
143 [combination = max] int amax() { return 12; }
144
145 [combination = custom,
146 decls = { struct item **head = &sod_ret; },
147 each = { *head = sod_val; head = &sod_val->next; },
148 after = { *head = 0; }]
149 struct item *alist() { return make_item("base"); }
150
151 [combination = custom,
152 decls = { int *v; size_t i = 0; }, methty = <int>, count = n,
153 before = { v = xmalloc(n*sizeof(int)); },
154 each = { v[i++] = sod_val; },
155 after = { sod_ret.v = v; sod_ret.n = n; }]
156 struct vec avec();
157 int t1base.avec() { return 19; }
158 }
159
160 [link = T1Base, nick = t1sub]
161 class T1Sub : T1Base {
162 void t1base.aprogn() { STEP(0); }
163 int t1base.asum() { return 2; }
164 int t1base.aand() { return 6; }
165 int t1base.amax() { return 17; }
166 struct item *t1base.alist() { return make_item("sub"); }
167 int t1base.avec() { return 4; }
168 }
169
170 code c : tests {
171 prepare("aggregate, base");
172 { SOD_DECL(T1Base, t1, NO_KWARGS);
173 struct item *l;
174 struct vec v;
175 STEP(0); T1Base_aprogn(t1); /* 1 */
176 if (T1Base_asum(t1) == 1) STEP(2);
177 if (T1Base_aand(t1) == 8) STEP(3);
178 if (T1Base_amax(t1) == 12) STEP(4);
179 l = T1Base_alist(t1);
180 if (!check_list(l, "base", (const char *)0)) STEP(5);
181 free_list(l);
182 v = T1Base_avec(t1);
183 if (!check_vec(&v, 19, -1)) STEP(6);
184 free_vec(&v);
185 DONE(7);
186 }
187 prepare("aggregate, sub");
188 { SOD_DECL(T1Sub, t1, NO_KWARGS);
189 struct item *l;
190 struct vec v;
191 T1Base_aprogn(t1); /* 0, 1 */
192 if (T1Base_asum(t1) == 3) STEP(2);
193 if (T1Base_aand(t1) == 8) STEP(3);
194 if (T1Base_amax(t1) == 17) STEP(4);
195 l = T1Base_alist(t1);
196 if (!check_list(l, "sub", "base", (const char *)0)) STEP(5);
197 free_list(l);
198 v = T1Base_avec(t1);
199 if (!check_vec(&v, 4, 19, -1)) STEP(6);
200 free_vec(&v);
201 DONE(7);
202 }
203 }
204
205 /*----- Slot and user initargs --------------------------------------------*/
206
207 [link = SodObject, nick = t2]
208 class T2 : SodObject {
209 [initarg = x] int x = 0;
210
211 initarg int y = 1;
212 init { if (!y) STEP(0); }
213 }
214
215 code c : tests {
216 prepare("initargs, defaults");
217 { SOD_DECL(T2, t, NO_KWARGS);
218 if (t->t2.x == 0) STEP(0);
219 DONE(1);
220 }
221 prepare("initargs, explicit");
222 { SOD_DECL(T2, t, KWARGS(K(x, 42) K(y, 0)));
223 if (t->t2.x == 42) STEP(1);
224 DONE(2);
225 }
226 }
227
228 /*----- Keyword argument propagation --------------------------------------*/
229
230 [link = SodObject, nick = base]
231 class T3Base : SodObject {
232 void m0(?int x) { STEP(x); }
233 void m1(?) { }
234 }
235
236 [link = T3Base, nick = mid]
237 class T3Mid : T3Base {
238 void base.m0(?int y) { STEP(y); CALL_NEXT_METHOD; }
239 void base.m1(?) { STEP(4); CALL_NEXT_METHOD; }
240 }
241
242 [link = T3Mid, nick = sub]
243 class T3Sub : T3Mid {
244 void base.m0(?int z) { STEP(z); CALL_NEXT_METHOD; }
245 void base.m1(?int z) { STEP(z); CALL_NEXT_METHOD; }
246 }
247
248 code c : tests {
249 prepare("kwargs");
250 { SOD_DECL(T3Sub, t, NO_KWARGS);
251 T3Base_m0(t, KWARGS(K(z, 0) K(y, 1) K(x, 2)));
252 T3Base_m1(t, KWARGS(K(z, 3)));
253 DONE(5);
254 }
255 }
256
257 /*----- That's all, folks -------------------------------------------------*/