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