Adding sexp_maybe_wrap_error utility to pass exceptions from the FFI without raising.

Fixes issue #156.

eval.c

@@ -60,6 +60,18 @@ sexp sexp_warn_undefs_op (sexp ctx, sexp self, sexp_sint_t n, sexp from, sexp to
   return SEXP_VOID;
 }
 
+sexp sexp_maybe_wrap_error (sexp ctx, sexp obj) {
+  sexp_gc_var2(tmp, res);
+  if (sexp_exceptionp(obj)) {
+    sexp_gc_preserve2(ctx, tmp, res);
+    tmp = obj;
+    tmp = sexp_list1(ctx, tmp);
+    res = sexp_make_trampoline(ctx, SEXP_FALSE, tmp);
+    sexp_gc_release2(ctx);
+    return res;
+  }
+  return obj;
+}
 
 /********************** environment utilities ***************************/
 

include/chibi/eval.h

@@ -59,6 +59,7 @@ SEXP_API void sexp_scheme_init (void);
 SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env, sexp_uint_t size, sexp_uint_t max_size);
 SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda);
 SEXP_API sexp sexp_compile_error (sexp ctx, const char *message, sexp obj);
+SEXP_API sexp sexp_maybe_wrap_error (sexp ctx, sexp obj);
 SEXP_API sexp sexp_analyze (sexp context, sexp x);
 SEXP_API sexp sexp_simplify (sexp ctx, sexp self, sexp_sint_t n, sexp ast);
 SEXP_API sexp sexp_make_lambda (sexp ctx, sexp params);

tests/ffi/ffi-tests.scm

@@ -14,7 +14,14 @@
          (lambda (out) (write 'decls out) (newline out)))
        (let ((res (system
                    "./chibi-scheme" "tools/chibi-ffi" "-c"
-                   "-f" "-O0 -L. -Iinclude" stub-file)))
+                   "-f" (string-append
+                         "-O0 -L. -Iinclude"
+                         (cond-expand
+                          (boehm-gc
+                           " -DSEXP_USE_BOEHM=1 -I/opt/local/include")
+                          (else
+                           "")))
+                   stub-file)))
          (cond
           ((zero? (cadr res))
            (load lib-file)
@@ -294,6 +301,22 @@ double circle_area2(struct Circle circ) {
  (test 1 (color_red (make_color 1 2 3)))
  )
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Exception wrapping.
+
+(test-ffi
+ "exceptions"
+ (begin
+   (c-declare "
+sexp usererror(sexp ctx, sexp self, const char* str) {
+  return sexp_maybe_wrap_error(ctx, sexp_user_exception(ctx, self, str, SEXP_NULL));
+}
+")
+   (define-c sexp usererror
+     ((value ctx sexp) (value self sexp) string)))
+ (test-assert (exception? (usererror "BOOM!")))
+ (test-error (usererror 'not-a-string)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; More complex return parameters.