1 /*===========================================================================
2 * Filename : test-storage-compact.c
3 * About : storage layer tests specific to storage-compact
4 *
5 * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
6 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
7 *
8 * All rights reserved.
9 *
10 * Redistribution and use in source and binary forms, with or without
11 * modification, are permitted provided that the following conditions
12 * are met:
13 *
14 * 1. Redistributions of source code must retain the above copyright
15 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
19 * 3. Neither the name of authors nor the names of its contributors
20 * may be used to endorse or promote products derived from this software
21 * without specific prior written permission.
22 *
23 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
24 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
27 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
30 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
32 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
33 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34 ===========================================================================*/
35
36 #include <sigscheme/config.h>
37 #if !SCM_USE_STORAGE_COMPACT
38 #define TST_EXCLUDE_THIS
39 #endif
40
41 #include "sscm-test.h"
42 #include "sigschemeinternal.h"
43 #include "utils.c"
44
45
46 #if SCM_USE_STORAGE_COMPACT
47
48 /* temporary workaround. see the comment of storage.c */
49 #if 1
50 #define SCM_CONS_INIT(obj, kar, kdr) \
51 SCM_TYPESAFE_MACRO_VOID(SCM_ISAL_CONS_INIT, \
52 (ScmObj, ScmObj, ScmObj), \
53 ((obj), (kar), (kdr)))
54
55 #define SCM_SYMBOL_INIT(obj, nam, val) \
56 SCM_TYPESAFE_MACRO_VOID(SCM_ISAL_SYMBOL_INIT, \
57 (ScmObj, char*, ScmObj), \
58 ((obj), (nam), (val)))
59 #endif
60
61 TST_CASE("tag-consistent?")
62 {
63 ScmCell *cell;
64 ScmObj obj;
65
66 cell = malloc_aligned_8(sizeof(*cell));
67 obj = (ScmObj)cell;
68 SCM_SYMBOL_INIT(obj, NULL, SCM_NULL);
69 TST_COND(SCM_CELL_MISCP(*cell), "cell-misc?");
70 TST_COND(SCM_CELL_SYMBOLP(*cell), "cell-symbol?");
71 TST_COND(SCM_SYMBOLP(obj), "init -> symbol?");
72 TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
73 "consistent? (ptag = misc, cell = misc)");
74 SCM_PTAG_SET(obj, SCM_PTAG_CONS);
75 TST_COND(CONSP(obj), "set ptag -> pair?");
76 TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
77 "inconsistent? (ptag = pair, cell = misc)");
78 SCM_PTAG_SET(obj, SCM_PTAG_CLOSURE);
79 TST_COND(SCM_CLOSUREP(obj), "set ptag -> closure?");
80 TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
81 "inconsistent? (ptag = closure, cell = misc)");
82 /* Immediate objects pointing to misc cells are harmless. */
83
84 obj = (ScmObj)cell;
85 SCM_CONS_INIT(obj, SCM_TRUE, SCM_FALSE);
86 TST_COND(!SCM_CELL_MISCP(*cell), "not cell-misc?");
87 TST_COND(SCM_CONSP(obj), "init -> pair?");
88 TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
89 "consistent? (ptag = pair, cell = pair)");
90 SCM_PTAG_SET(obj, SCM_PTAG_CLOSURE);
91 TST_COND(SCM_CLOSUREP(obj), "set ptag -> closure?");
92 /* Pair and closure have the same memory layout. */
93 TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
94 "consistent? (ptag = closure, cell = pair)");
95 SCM_PTAG_SET(obj, SCM_PTAG_MISC);
96 TST_COND(SCM_MISCP(obj), "set ptag -> misc?");
97 TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
98 "consistent? (ptag = misc, cell = pair)");
99 /* Immediate objects pointing to misc cells are harmless. */
100
101 free(cell);
102 }
103
104
105 static scm_bool
cell_types_disjunct(ScmCell * cell)106 cell_types_disjunct(ScmCell *cell)
107 {
108 int tested_true = 0;
109 tested_true += !!SCM_CELL_SYMBOLP(*cell);
110 tested_true += !!SCM_CELL_STRINGP(*cell);
111 tested_true += !!SCM_CELL_VECTORP(*cell);
112 tested_true += !!SCM_CELL_PORTP(*cell);
113 tested_true += !!SCM_CELL_CONTINUATIONP(*cell);
114 return tested_true == 1;
115 }
116
117 TST_CASE("cell type predicates")
118 {
119 ScmObj obj;
120
121 #if SCM_USE_VECTOR
122 ScmObj *vec;
123 #endif
124
125 #define TYPE_TST(typ) \
126 TST_COND(SCM_CELL_##typ##P(*SCM_UNTAG_PTR(obj)) \
127 && cell_types_disjunct(SCM_UNTAG_PTR(obj)), \
128 "CELL_" #typ "P()")
129
130 #if SCM_USE_VECTOR
131 vec = malloc_aligned_8(sizeof(ScmObj) * 3);
132 vec[0] = SCM_NULL;
133 vec[1] = SCM_MAKE_INT(8);
134 vec[2] = SCM_FALSE;
135 obj = SCM_MAKE_VECTOR(vec, 3);
136 TYPE_TST(VECTOR);
137 #endif
138
139 obj = scm_p_current_input_port();
140 TYPE_TST(PORT);
141
142 obj = SCM_SYM_QUOTE;
143 TYPE_TST(SYMBOL);
144 obj = SCM_MAKE_SYMBOL(NULL, SCM_NULL);
145 TYPE_TST(SYMBOL);
146
147 {
148 char str[] = "some string";
149 char *p;
150 p = aligned_dup(str, sizeof(str));
151 obj = SCM_MAKE_STRING(p, sizeof(str)-1);
152 TYPE_TST(STRING);
153 }
154
155 /* TODO: continuation */
156 }
157
158 SCM_MISC_DECLARE_TYPE(INTOBJ0, L1(3),
159 SCM_MISC_XTYPE(scm_intobj_t), SCM_MISC_XALIGN(0),
160 SCM_MISC_YTYPE(scm_intobj_t));
161 #define SCM_AS_INTOBJ0(o) (o)
162 #define SCM_INTOBJ0_PTR(o) SCM_MISC_PTR((o), INTOBJ0)
163
164 SCM_MISC_DECLARE_TYPE(INTOBJ1, L1(3),
165 SCM_MISC_XTYPE(scm_intobj_t), SCM_MISC_XALIGN(1),
166 SCM_MISC_YTYPE(scm_intobj_t));
167 #define SCM_AS_INTOBJ1(o) (o)
168 #define SCM_INTOBJ1_PTR(o) SCM_MISC_PTR((o), INTOBJ1)
169
170 SCM_MISC_DECLARE_TYPE(INTOBJ2, L1(3),
171 SCM_MISC_XTYPE(scm_intobj_t), SCM_MISC_XALIGN(2),
172 SCM_MISC_YTYPE(scm_intobj_t));
173 #define SCM_AS_INTOBJ2(o) (o)
174 #define SCM_INTOBJ2_PTR(o) SCM_MISC_PTR((o), INTOBJ2)
175
176 TST_CASE("misc obj fullsize S->X")
177 {
178 ScmCell *heap;
179 ScmObj o;
180
181 heap = scm_malloc_aligned(SCM_DEFAULT_HEAP_SIZE * sizeof(ScmCell));
182
183 TST_TN_FALSE(SCM_MISC_INTOBJ0_XDIRECTP);
184 TST_TN_FALSE(SCM_MISC_INTOBJ0_XSHIFTP);
185 TST_TN_TRUE (SCM_MISC_INTOBJ0_XSPLITP);
186 TST_TN_EQ_INT(1, SCM_MISC_INTOBJ0_XSPILL);
187 o = (ScmObj)&heap[0];
188 SCM_MISC_INIT(o, -1, 0, INTOBJ0);
189 TST_TN_EQ_INT(-1, SCM_MISC_X(o, INTOBJ0));
190 TST_TN_EQ_INT(0, SCM_MISC_Y(o, INTOBJ0));
191 o = (ScmObj)&heap[0];
192 SCM_MISC_INIT(o, 0, -1, INTOBJ0);
193 TST_TN_EQ_INT(0, SCM_MISC_X(o, INTOBJ0));
194 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, INTOBJ0));
195
196 TST_TN_TRUE (SCM_MISC_INTOBJ1_XDIRECTP);
197 TST_TN_FALSE(SCM_MISC_INTOBJ1_XSHIFTP);
198 TST_TN_FALSE(SCM_MISC_INTOBJ1_XSPLITP);
199 TST_TN_EQ_INT(0, SCM_MISC_INTOBJ1_XSPILL);
200 o = (ScmObj)&heap[0];
201 SCM_MISC_INIT(o, -1, 0, INTOBJ1);
202 TST_TN_EQ_INT(-1, SCM_MISC_X(o, INTOBJ1));
203 TST_TN_EQ_INT(0, SCM_MISC_Y(o, INTOBJ1));
204 o = (ScmObj)&heap[0];
205 SCM_MISC_INIT(o, 0, -1, INTOBJ1);
206 TST_TN_EQ_INT(0, SCM_MISC_X(o, INTOBJ1));
207 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, INTOBJ1));
208
209 TST_TN_TRUE (SCM_MISC_INTOBJ2_XDIRECTP);
210 TST_TN_FALSE(SCM_MISC_INTOBJ2_XSHIFTP);
211 TST_TN_FALSE(SCM_MISC_INTOBJ2_XSPLITP);
212 TST_TN_EQ_INT(0, SCM_MISC_INTOBJ2_XSPILL);
213 o = (ScmObj)&heap[0];
214 SCM_MISC_INIT(o, -1, 0, INTOBJ2);
215 TST_TN_EQ_INT(-1, SCM_MISC_X(o, INTOBJ2));
216 TST_TN_EQ_INT(0, SCM_MISC_Y(o, INTOBJ2));
217 o = (ScmObj)&heap[0];
218 SCM_MISC_INIT(o, 0, -1, INTOBJ2);
219 TST_TN_EQ_INT(0, SCM_MISC_X(o, INTOBJ2));
220 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, INTOBJ2));
221
222 free(heap);
223 }
224
225 SCM_MISC_DECLARE_TYPE(SHORT0, L1(3),
226 SCM_MISC_XTYPE(int16_t), SCM_MISC_XALIGN(0),
227 SCM_MISC_YTYPE(int16_t));
228 #define SCM_AS_SHORT0(o) (o)
229 #define SCM_SHORT0_PTR(o) SCM_MISC_PTR((o), SHORT0)
230
231 SCM_MISC_DECLARE_TYPE(SHORT1, L1(3),
232 SCM_MISC_XTYPE(int16_t), SCM_MISC_XALIGN(1),
233 SCM_MISC_YTYPE(int16_t));
234 #define SCM_AS_SHORT1(o) (o)
235 #define SCM_SHORT1_PTR(o) SCM_MISC_PTR((o), SHORT1)
236
237 SCM_MISC_DECLARE_TYPE(SHORT2, L1(3),
238 SCM_MISC_XTYPE(int16_t), SCM_MISC_XALIGN(2),
239 SCM_MISC_YTYPE(int16_t));
240 #define SCM_AS_SHORT2(o) (o)
241 #define SCM_SHORT2_PTR(o) SCM_MISC_PTR((o), SHORT2)
242
243 TST_CASE("misc obj 16-bit S->X")
244 {
245 ScmCell *heap;
246 ScmObj o;
247
248 heap = scm_malloc_aligned(SCM_DEFAULT_HEAP_SIZE * sizeof(ScmCell));
249
250 TST_TN_FALSE(SCM_MISC_SHORT0_XDIRECTP);
251 TST_TN_TRUE (SCM_MISC_SHORT0_XSHIFTP);
252 TST_TN_FALSE(SCM_MISC_SHORT0_XSPLITP);
253 TST_TN_EQ_INT(1, SCM_MISC_SHORT0_XSPILL);
254 o = (ScmObj)&heap[0];
255 SCM_MISC_INIT(o, -1, 0, SHORT0);
256 TST_TN_EQ_INT(-1, SCM_MISC_X(o, SHORT0));
257 TST_TN_EQ_INT(0, SCM_MISC_Y(o, SHORT0));
258 o = (ScmObj)&heap[0];
259 SCM_MISC_INIT(o, 0, -1, SHORT0);
260 TST_TN_EQ_INT(0, SCM_MISC_X(o, SHORT0));
261 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, SHORT0));
262
263 TST_TN_TRUE (SCM_MISC_SHORT1_XDIRECTP);
264 TST_TN_FALSE(SCM_MISC_SHORT1_XSHIFTP);
265 TST_TN_FALSE(SCM_MISC_SHORT1_XSPLITP);
266 TST_TN_EQ_INT(0, SCM_MISC_SHORT1_XSPILL);
267 o = (ScmObj)&heap[0];
268 SCM_MISC_INIT(o, -1, 0, SHORT1);
269 TST_TN_EQ_INT(-1, SCM_MISC_X(o, SHORT1));
270 TST_TN_EQ_INT(0, SCM_MISC_Y(o, SHORT1));
271 o = (ScmObj)&heap[0];
272 SCM_MISC_INIT(o, 0, -1, SHORT1);
273 TST_TN_EQ_INT(0, SCM_MISC_X(o, SHORT1));
274 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, SHORT1));
275
276 TST_TN_TRUE (SCM_MISC_SHORT2_XDIRECTP);
277 TST_TN_FALSE(SCM_MISC_SHORT2_XSHIFTP);
278 TST_TN_FALSE(SCM_MISC_SHORT2_XSPLITP);
279 TST_TN_EQ_INT(0, SCM_MISC_SHORT2_XSPILL);
280 o = (ScmObj)&heap[0];
281 SCM_MISC_INIT(o, -1, 0, SHORT2);
282 TST_TN_EQ_INT(-1, SCM_MISC_X(o, SHORT2));
283 TST_TN_EQ_INT(0, SCM_MISC_Y(o, SHORT2));
284 o = (ScmObj)&heap[0];
285 SCM_MISC_INIT(o, 0, -1, SHORT2);
286 TST_TN_EQ_INT(0, SCM_MISC_X(o, SHORT2));
287 TST_TN_EQ_INT(-1, SCM_MISC_Y(o, SHORT2));
288
289 free(heap);
290 }
291
292
293 /* TODO: add tests for the GC algorithm (perhaps by #include'ing a
294 * part of storage-gc.c extracted with sed -n '/^gc_mark/,/^}/ p' ) */
295 #endif /* SCM_USE_STORAGE_COMPACT */
296