test: Split-up Mescc scaffold test.
[mes.git] / scaffold / tests / 63-struct-cell.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of Mes.
6  *
7  * Mes is free software; you can redistribute it and/or modify it
8  * under the terms of the GNU General Public License as published by
9  * the Free Software Foundation; either version 3 of the License, or (at
10  * your option) any later version.
11  *
12  * Mes is distributed in the hope that it will be useful, but
13  * WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
19  */
20
21 #include "30-test.i"
22
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <string.h>
26
27 int
28 add (int a, int b)
29 {
30   return a + b;
31 }
32
33 int
34 inc (int i)
35 {
36   return i + 1;
37 }
38
39 struct scm {
40   int type;
41   int car;
42   int cdr;
43 };
44
45 int bla = 1234;
46 char g_arena[84];
47 #if __MESC__
48 struct scm *g_cells = g_arena;
49 #else
50 struct scm *g_cells = (struct scm*)g_arena;
51 #endif
52 char *g_chars = g_arena;
53
54 int foo () {puts ("t: foo\n"); return 0;};
55 int bar (int i) {puts ("t: bar\n"); return 0;};
56 struct function {
57   int (*function) (void);
58   int arity;
59   char *name;
60 };
61 struct function g_fun = {&exit,1,"fun"};
62 struct function g_foo = {&foo,0,"foo"};
63 struct function g_bar = {&bar,1,"bar"};
64
65 //void *functions[2];
66 int functions[2];
67
68 struct function g_functions[2];
69 int g_function = 0;
70
71 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
72
73 typedef int SCM;
74 int g_free = 3;
75 SCM tmp;
76 SCM tmp_num;
77
78 int ARENA_SIZE = 200;
79 #define TYPE(x) g_cells[x].type
80 #define CAR(x) g_cells[x].car
81 #define CDR(x) g_cells[x].cdr
82 #define VALUE(x) g_cells[x].cdr
83
84 #define CAAR(x) CAR (CAR (x))
85
86 struct scm scm_fun = {TFUNCTION,0,0};
87 SCM cell_fun;
88
89
90 int
91 test ()
92 {
93   puts ("\n");
94   puts ("t: g_cells[0] = g_cells[1]\n");
95   TYPE (1) = 1;
96   CAR (1) = 2;
97   CDR (1) = 3;
98   g_cells[0] = g_cells[1];
99   if (TYPE (0) != 1) return 1;
100   if (CAR (0) != 2) return 2;
101   if (CDR (0) != 3) return 3;
102
103   puts ("t: g_cells[i] = g_cells[j]\n");
104   int i = 0;
105   int j = 1;
106   TYPE (1) = 4;
107   CAR (1) = 5;
108   CDR (1) = 6;
109   g_cells[i] = g_cells[j];
110   if (TYPE (0) != 4) return 1;
111   if (CAR (0) != 5) return 2;
112   if (CDR (0) != 6) return 3;
113
114   puts ("t: g_cells[0+add(0,0] = g_cells[0+inc(0)]\n");
115   TYPE (1) = 1;
116   CAR (1) = 2;
117   CDR (1) = 3;
118   g_cells[0+add(0, 0)] = g_cells[0+inc(0)];
119   if (TYPE (0) != 1) return 1;
120   if (CAR (0) != 2) return 2;
121   if (CDR (0) != 3) return 3;
122
123   g_cells[0].type = TNUMBER;
124   g_cells[0].car = 0;
125   g_cells[0].cdr = 0;
126   g_cells[1].type = TNUMBER;
127   g_cells[1].car = 0;
128   g_cells[1].cdr = 0;
129
130   puts ("t: TYPE (0) != TYPE (1)\n");
131   if (TYPE (0) == TYPE (1)) goto ok;
132   return 1;
133  ok:
134
135   g_cells[0].car = 1;
136   g_cells[1].car = 2;
137
138   puts ("t: int c = VALUE (0)\n");
139   int c = CAR (0);
140   if (c != 1) return 1;
141
142   puts ("t: CAAR (0) != 2\n");
143   if (CAAR (0) != 2) return 1;
144
145   puts ("t: 2 != CAAR (0)\n");
146   if (2 != CAAR (0)) return 1;
147
148   g_cells[3].type = 0x64;
149   if (g_cells[3].type != 0x64)
150     return g_cells[3].type;
151
152   TYPE (4) = 4;
153   if (TYPE (4) != 4)
154     return 4;
155   
156   CDR (3) = 0x22;
157   CDR (4) = 0x23;
158   if (CDR (3) != 0x22)
159     return CDR (3);
160
161   puts ("t: g_fun.arity != 1;\n");
162   if (g_fun.arity != 1) return 1;
163
164   puts ("t: g_fun.function != exit;\n");
165   if (g_fun.function != &exit) return 1;
166
167   puts ("t: struct fun = {&exit,1,\"exit\"};\n");
168   struct function fun = {&exit,1,"exit"};
169
170   puts ("t: fun.arity != 1;\n");
171   if (fun.arity != 1) return 1;
172
173   puts ("t: fun.function != exit;\n");
174   if (fun.function != &exit) return 1;
175
176   puts ("t: puts (fun.name)\n");
177   if (strcmp (fun.name, "exit")) return 1;
178
179   puts ("t: puts (g_fun.name)\n");
180   if (strcmp (g_fun.name, "fun")) return 1;
181
182   puts ("t: g_functions[g_function++] = g_foo;\n");
183   g_functions[g_function++] = g_foo;
184
185   puts ("t: pbar->arity == 1\n");
186   struct function* barp = &g_bar;
187   if (barp->arity != 1) return 1;
188
189   int fn = 0;
190   puts ("t: g_functions[g_cells[fn].cdr].arity\n");
191   if (g_functions[g_cells[fn].cdr].arity) return 1;
192   if (g_functions[g_cells[fn].cdr].arity != 0) return 1;
193
194   int (*functionx) (void) = 0;
195   functionx = g_functions[0].function;
196   puts ("t: functionx == foo\n");
197   if (functionx != foo) return 11;
198
199   puts ("t: g_functions[0].name\n");
200   if (strcmp (g_functions[0].name, "foo")) return 1;
201
202   puts ("t: (functionx) () == foo\n");
203   if ((functionx) () != 0) return 12;
204
205   puts ("t: g_functions[<foo>].arity\n");
206   if (g_functions[0].arity != 0) return 17;
207
208   fn++;
209   g_functions[fn] = g_bar;
210   g_cells[fn].cdr = fn;
211   if (g_cells[fn].cdr != fn) return 13;
212
213   puts ("t: g_functions[g_cells[fn].cdr].function\n");
214   functionx = g_functions[g_cells[fn].cdr].function;
215
216   puts ("t: g_functions[1].name\n");
217   if (strcmp (g_functions[1].name, "bar")) return 1;
218
219   puts ("t: functionx == bar\n");
220   if (functionx != bar) return 15;
221
222   puts ("t: (functiony) (1) == bar\n");
223   int (*functiony) (int) = 0;
224   functiony = g_functions[g_cells[fn].cdr].function;
225   if ((functiony) (1) != 0) return 16;
226
227   puts ("t: g_functions[<bar>].arity\n");
228   if (g_functions[fn].arity != 1) return 18;
229
230   // fake name
231   scm_fun.car = 33;
232   scm_fun.cdr = g_function;
233   //g_functions[g_function++] = g_fun;
234   g_functions[g_function] = g_fun;
235   cell_fun = g_free++;
236   g_cells[cell_fun] = scm_fun;
237
238   puts ("t: TYPE (cell_fun)\n");
239   if (TYPE (cell_fun) != TFUNCTION) return 1;
240
241   puts ("t: CAR (cell_fun)\n");
242   if (CAR (cell_fun) != 33) return 1;
243
244   puts ("t: CDR (cell_fun)\n");
245   if (CDR (cell_fun) != g_function) return 1;
246
247   return 0;
248 }