root/src/test-vmstack.c
/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- message
- test_eval
- dummy_eproc
- main
1 /*
2 * Test VM stack sanity
3 * $Id: test-vmstack.c,v 1.3 2003/12/16 09:50:46 shirok Exp $
4 */
5
6 #include <stdio.h>
7 #include "gauche.h"
8 #include "gauche/vm.h"
9
10 int errcount = 0;
11
12 void message(FILE *out, const char *m, int filler)
13 {
14 int i;
15 fprintf(out, "%s", m);
16 if (filler) {
17 int len = 79 - strlen(m);
18 if (len < 0) len = 5;
19 for (i=0; i<len; i++) putc(filler, out);
20 }
21 putc('\n', out);
22 }
23
24 void test_eval(const char *msg, const char *sexp)
25 {
26 ScmObj *pre_stack = Scm_VM()->sp, *post_stack;
27 ScmObj x = Scm_ReadFromCString(sexp);
28 printf("%s ... ", msg);
29 SCM_UNWIND_PROTECT {
30 Scm_Eval(x, SCM_UNBOUND);
31 }
32 SCM_WHEN_ERROR {
33 }
34 SCM_END_PROTECT;
35
36 post_stack = Scm_VM()->sp;
37 if (pre_stack != post_stack) {
38 printf("ERROR.\n");
39 errcount++;
40 } else {
41 printf("ok\n");
42 }
43 }
44
45 ScmObj dummy_eproc(ScmObj *args, int nargs, void *data)
46 {
47 return SCM_UNDEFINED;
48 }
49
50 int main(int argc, char **argv)
51 {
52 ScmObj eproc;
53 const char *testmsg = "Testing VM stack sanity... ";
54
55 fprintf(stderr, "%-65s", testmsg);
56 message(stdout, testmsg, '=');
57 Scm_Init(GAUCHE_SIGNATURE);
58
59 eproc = Scm_MakeSubr(dummy_eproc, NULL, 0, 1, SCM_FALSE);
60 Scm_VM()->defaultEscapeHandler = eproc;
61
62 test_eval("simple expression", "(+ 1 2 3)");
63 test_eval("with-error-handler (1)",
64 "(with-error-handler (lambda (e) #f) (lambda () 1)))");
65 test_eval("with-error-handler (2)",
66 "(with-error-handler (lambda (e) #f) (lambda () (car 1))))");
67 test_eval("with-error-handler (2)",
68 "(car 3)");
69
70 if (errcount) {
71 fprintf(stderr, "failed.\n");
72 fprintf(stdout, "failed.\n");
73 } else {
74 fprintf(stderr, "passed.\n");
75 fprintf(stdout, "passed.\n");
76 }
77 return 0;
78 }