root/src/test-vmstack.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. message
  2. test_eval
  3. dummy_eproc
  4. 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 }

/* [<][>][^][v][top][bottom][index][help] */