FFI needs to check for FILE* backed ports when wrapping a C function that expects a FILE* and string streams are not supported.

Also fixing bug in make-custom-output-port that didn't check for exceptions.
This commit is contained in:
Alex Shinn 2011-12-17 14:51:58 +09:00
parent ad10e7d766
commit 9f25895e8c
3 changed files with 18 additions and 4 deletions

View file

@ -635,6 +635,12 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_portp(x) (sexp_iportp(x) || sexp_oportp(x))
#if SEXP_USE_STRING_STREAMS
#define sexp_stream_portp(x) 1
#else
#define sexp_stream_portp(x) (sexp_port_stream(x) != NULL)
#endif
/***************************** constructors ****************************/
#define sexp_make_boolean(x) ((x) ? SEXP_TRUE : SEXP_FALSE)

View file

@ -115,7 +115,7 @@ static int sexp_cookie_seeker (void *cookie, off64_t *position, int whence) {
sexp_gc_release2(ctx);
return sexp_fixnump(res);
}
#endif
#endif /* !SEXP_BSD */
static int sexp_cookie_cleaner (void *cookie) {
sexp vec = (sexp)cookie, ctx, res;
@ -141,7 +141,7 @@ static cookie_io_functions_t sexp_cookie_no_seek = {
.close = (cookie_close_function_t*)sexp_cookie_cleaner,
};
#endif
#endif /* !SEXP_BSD */
static sexp sexp_make_custom_port (sexp ctx, sexp self, char *mode,
sexp read, sexp write,
@ -184,7 +184,7 @@ static sexp sexp_make_custom_port (sexp ctx, sexp self, char *mode,
return res;
}
#else
#else /* ! SEXP_USE_STRING_STREAMS */
static sexp sexp_make_custom_port (sexp ctx, sexp self,
char *mode, sexp read, sexp write,
@ -202,6 +202,7 @@ static sexp sexp_make_custom_input_port (sexp ctx, sexp self,
static sexp sexp_make_custom_output_port (sexp ctx, sexp self,
sexp write, sexp seek, sexp close) {
sexp res = sexp_make_custom_port(ctx, self, "w", SEXP_FALSE, write, seek, close);
if (!sexp_exceptionp(res))
sexp_pointer_tag(res) = SEXP_OPORT;
return res;
}

View file

@ -762,6 +762,13 @@
args))
(define (write-additional-checks args)
(for-each
(lambda (a)
(if (port-type? (type-base a))
(cat " if (!sexp_stream_portp(arg" (type-index a) "))\n"
" return sexp_xtype_exception(ctx, self,"
" \"not a FILE* backed port\", arg" (type-index a) ");\n")))
args)
(for-each
(lambda (a)
(if (eq? 'input-port (type-base a))