← Back to branch summary

~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to test-c2/test-storage-compact.c

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2007-01-29 15:31:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070129153124-j5fcqyrwcfbczma7
Tags: 0.7.4-1
New upstream release.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test-c2/test-storage-compact.c
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
 
 *
7
 
 *  All rights reserved.
8
 
 *
9
 
 *  Redistribution and use in source and binary forms, with or without
10
 
 *  modification, are permitted provided that the following conditions
11
 
 *  are met:
12
 
 *
13
 
 *  1. Redistributions of source code must retain the above copyright
14
 
 *     notice, this list of conditions and the following disclaimer.
15
 
 *  2. Redistributions in binary form must reproduce the above copyright
16
 
 *     notice, this list of conditions and the following disclaimer in the
17
 
 *     documentation and/or other materials provided with the distribution.
18
 
 *  3. Neither the name of authors nor the names of its contributors
19
 
 *     may be used to endorse or promote products derived from this software
20
 
 *     without specific prior written permission.
21
 
 *
22
 
 *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23
 
 *  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24
 
 *  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25
 
 *  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26
 
 *  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27
 
 *  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28
 
 *  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
29
 
 *  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
30
 
 *  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
31
 
 *  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
32
 
 *  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
 
===========================================================================*/
34
 
 
35
 
#include <sigscheme/config.h>
36
 
#if !SCM_USE_STORAGE_COMPACT
37
 
#define TST_EXCLUDE_THIS
38
 
#endif
39
 
 
40
 
#include "sscm-test.h"
41
 
#include "sigschemeinternal.h"
42
 
#include "utils.c"
43
 
 
44
 
 
45
 
#if SCM_USE_STORAGE_COMPACT
46
 
 
47
 
/* temporary workaround. see the comment of storage.c */
48
 
#if 1
49
 
#define SCM_CONS_INIT(obj, kar, kdr)                    \
50
 
    SCM_TYPESAFE_MACRO_VOID(SCM_SAL_CONS_INIT,          \
51
 
                            (ScmObj, ScmObj, ScmObj),   \
52
 
                            ((obj), (kar), (kdr)))
53
 
 
54
 
#define SCM_SYMBOL_INIT(obj, nam, val)                  \
55
 
    SCM_TYPESAFE_MACRO_VOID(SCM_SAL_SYMBOL_INIT,        \
56
 
                            (ScmObj, char*, ScmObj),    \
57
 
                            ((obj), (nam), (val)))
58
 
#endif
59
 
 
60
 
TST_CASE("tag-consistent?")
61
 
{
62
 
    ScmCell *cell;
63
 
    ScmObj obj;
64
 
 
65
 
    cell = malloc_aligned_8(sizeof(*cell));
66
 
    obj = (ScmObj)cell;
67
 
    SCM_SYMBOL_INIT(obj, NULL, SCM_NULL);
68
 
    TST_COND(SCM_CELL_MISCP(*cell), "cell-misc?");
69
 
    TST_COND(SCM_CELL_SYMBOLP(*cell), "cell-symbol?");
70
 
    TST_COND(SCM_SYMBOLP(obj), "init -> symbol?");
71
 
    TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
72
 
             "consistent? (ptag = misc, cell = misc)");
73
 
    SCM_PTAG_SET(obj, SCM_PTAG_CONS);
74
 
    TST_COND(CONSP(obj), "set ptag -> pair?");
75
 
    TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
76
 
             "inconsistent? (ptag = pair, cell = misc)");
77
 
    SCM_PTAG_SET(obj, SCM_PTAG_CLOSURE);
78
 
    TST_COND(SCM_CLOSUREP(obj), "set ptag -> closure?");
79
 
    TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
80
 
             "inconsistent? (ptag = closure, cell = misc)");
81
 
    /* Immediate objects pointing to misc cells are harmless. */
82
 
 
83
 
    obj = (ScmObj)cell;
84
 
    SCM_CONS_INIT(obj, SCM_TRUE, SCM_FALSE);
85
 
    TST_COND(!SCM_CELL_MISCP(*cell), "not cell-misc?");
86
 
    TST_COND(SCM_CONSP(obj), "init -> pair?");
87
 
    TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
88
 
             "consistent? (ptag = pair, cell = pair)");
89
 
    SCM_PTAG_SET(obj, SCM_PTAG_CLOSURE);
90
 
    TST_COND(SCM_CLOSUREP(obj), "set ptag -> closure?");
91
 
    /* Pair and closure have the same memory layout. */
92
 
    TST_COND(SCM_TAG_CONSISTENTP(obj, *cell),
93
 
             "consistent? (ptag = closure, cell = pair)");
94
 
    SCM_PTAG_SET(obj, SCM_PTAG_MISC);
95
 
    TST_COND(SCM_MISCP(obj), "set ptag -> misc?");
96
 
    TST_COND(!SCM_TAG_CONSISTENTP(obj, *cell),
97
 
             "consistent? (ptag = misc, cell = pair)");
98
 
    /* Immediate objects pointing to misc cells are harmless. */
99
 
 
100
 
    free(cell);
101
 
}
102
 
 
103
 
 
104
 
static scm_bool
105
 
cell_types_disjunct(ScmCell *cell)
106
 
{
107
 
    int tested_true = 0;
108
 
    tested_true += !!SCM_CELL_SYMBOLP(*cell);
109
 
    tested_true += !!SCM_CELL_STRINGP(*cell);
110
 
    tested_true += !!SCM_CELL_VECTORP(*cell);
111
 
    tested_true += !!SCM_CELL_PORTP(*cell);
112
 
    tested_true += !!SCM_CELL_CONTINUATIONP(*cell);
113
 
    return tested_true == 1;
114
 
}
115
 
 
116
 
TST_CASE("cell type predicates")
117
 
{
118
 
    ScmObj obj;
119
 
 
120
 
    ScmObj *vec;
121
 
 
122
 
#define TYPE_TST(typ)                                           \
123
 
    TST_COND(SCM_CELL_##typ##P(*SCM_UNTAG_PTR(obj))             \
124
 
             && cell_types_disjunct(SCM_UNTAG_PTR(obj)),        \
125
 
             "CELL_" #typ "P()")
126
 
 
127
 
    vec = malloc_aligned_8(sizeof(ScmObj) * 3);
128
 
    vec[0] = SCM_NULL;
129
 
    vec[1] = SCM_MAKE_INT(8);
130
 
    vec[2] = SCM_FALSE;
131
 
    obj = SCM_MAKE_VECTOR(vec, 3);
132
 
    TYPE_TST(VECTOR);
133
 
 
134
 
    obj = scm_p_current_input_port();
135
 
    TYPE_TST(PORT);
136
 
 
137
 
    obj = SCM_SYM_QUOTE;
138
 
    TYPE_TST(SYMBOL);
139
 
    obj = SCM_MAKE_SYMBOL(NULL, SCM_NULL);
140
 
    TYPE_TST(SYMBOL);
141
 
 
142
 
    {
143
 
        char str[] = "some string";
144
 
        char *p;
145
 
        p = aligned_dup(str, sizeof(str));
146
 
        obj = SCM_MAKE_STRING(p, sizeof(str)-1);
147
 
        TYPE_TST(STRING);
148
 
    }
149
 
 
150
 
    /* TODO: continuation */
151
 
}
152
 
 
153
 
 
154
 
/* TODO: add tests for the GC algorithm (perhaps by #include'ing a
155
 
 * part of storage-gc.c extracted with sed -n '/^gc_mark/,/^}/ p' ) */
156
 
#endif /* SCM_USE_STORAGE_COMPACT */