* coop.c (coop_finish): New function. Called at exit.

[bpt/guile.git] / libguile / gh_test_c.c

diff --git a/libguile/gh_test_c.c b/libguile/gh_test_c.c
index 43ae1cf..9b4e37e 100644 (file)
--- a/libguile/gh_test_c.c
+++ b/libguile/gh_test_c.c
@@ -50,7 +50,7 @@ SCM c_factorial (SCM s_n);
 SCM c_sin (SCM s_x);
 SCM c_vector_test (SCM s_length);
 
-/* the gh_enter() routine, the standard entryp point for the gh_
+/* the gh_enter() routine, the standard entry point for the gh_
    interface, makes you use a separate main function */
 void 
 main_prog (int argc, char *argv[])
@@ -75,7 +75,12 @@ main_prog (int argc, char *argv[])
     sym_string = gh_symbol2newstr (sym, NULL);
     printf ("the symbol was <%s>; after converting to Scheme and back to\n",
            "a-test-symbol");
-    printf ("a C string it is now <%s>\n", sym_string);
+    printf ("    a C string it is now <%s>", sym_string);
+    if (strcmp("a-test-symbol", sym_string) == 0) {
+      printf("...PASS\n");
+    } else {
+      printf("...FAIL\n");
+    }
     free (sym_string);
   }
 
@@ -97,12 +102,24 @@ main_prog (int argc, char *argv[])
 
   gh_eval_str_with_standard_handler ("(display \"dude!\n\")");
 
-  /* in this next line I have a wilful typo: dosplay is not a defined
+  /* in this next test I have a wilful typo: dosplay is not a defined
      procedure, so it should throw an error */
+  printf("We should now get an error which should be trapped by a handler\n");
   gh_eval_str_with_standard_handler ("(dosplay \"dude!\n\")");
+  printf("now we will display a backtrace of that error; this should not\n");
+  printf("    work because the handler did not save the stack\n");
+  gh_eval_str("(backtrace)");
+
+  /* now do that test with a stack saving handler */
+  printf("Redo last test with stack-saving handler\n");
+  gh_eval_str_with_stack_saving_handler ("(dosplay \"dude!\n\")");
+  printf("now we will display a backtrace of that error; this should work:\n");
+  gh_eval_str("(backtrace)");
 
   /* now define some new primitives in C */
   cf = gh_new_procedure1_0 ("c-factorial", c_factorial);
+  gh_display (cf);
+  gh_newline ();
   gh_new_procedure1_0 ("c-sin", c_sin);
   gh_new_procedure1_0 ("c-vector-test", c_vector_test);
 
@@ -211,12 +228,12 @@ c_vector_test (SCM s_length)
   unsigned long c_length;
 
   c_length = gh_scm2ulong (s_length);
-  printf ("VECTOR test -- requested length for vector: %ld", c_length);
+  printf ("VECTOR test (length for vector %ld)", c_length);
 
   /* create a vector filled witth 0.0 entries */
   xvec = gh_make_vector (s_length, gh_double2scm (0.0));
   /* set the second element in it to some floating point value */
-  gh_vector_set (xvec, gh_int2scm(2), gh_double2scm (1.9));
+  gh_vector_set_x (xvec, gh_int2scm(2), gh_double2scm (1.9));
 
   /* I think I can use == because Scheme's doubles should be the same
      as C doubles, with no operations in between */
@@ -228,3 +245,9 @@ c_vector_test (SCM s_length)
 
   return xvec;
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/