From 0b1f96ab3d5893e874c4287024d791d26fa7f234 Mon Sep 17 00:00:00 2001 From: Tobias Hammer Date: Tue, 27 Aug 2013 17:15:46 +0200 Subject: [PATCH] Add missing fender to define-cstruct prevents internal error from libffi for (define-cstruct _S ()) --- .../racket-doc/scribblings/foreign/types.scrbl | 7 ++++--- racket/collects/ffi/unsafe.rkt | 18 ++++++++++++------ racket/src/foreign/foreign.c | 4 ++-- racket/src/foreign/foreign.rktc | 4 ++-- 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl index bd8d1c7b8c..7a841c4f9a 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -946,7 +946,7 @@ string carries its size information.} @section{C Struct Types} -@defproc[(make-cstruct-type [types (listof ctype?)] +@defproc[(make-cstruct-type [types (non-empty-listof ctype?)] [abi (or/c #f 'default 'stdcall 'sysv) #f] [alignment (or/c #f 1 2 4 8 16) #f]) ctype?]{ @@ -980,7 +980,7 @@ below for a more efficient approach.} @defform/subs[(define-cstruct id/sup ([field-id type-expr] ...) property ...) [(id/sup _id - (_id super-id)) + (_id _super-id)) (property (code:line #:alignment alignment-expr) (code:line #:property prop-expr val-expr) #:no-equal)]]{ @@ -991,7 +991,8 @@ marshaling them to Racket values. The syntax is similar to @racket[define-struct], providing accessor functions for raw struct values (which are pointer objects); the @racket[_id] must start with @litchar{_}, and at most one @racket[#:alignment] -can be supplied. +can be supplied. If no @racket[_super-id] is provided, then at least one +field must be specified. The resulting bindings are as follows: diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 52f3ef1793..1afec18cf0 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -1315,10 +1315,11 @@ ;; Simple structs: call this with a list of types, and get a type that marshals ;; C structs to/from Scheme lists. -(define* (_list-struct #:alignment [alignment #f] . types) +(define* (_list-struct #:alignment [alignment #f] type . types) (let ([stype (make-cstruct-type types #f alignment)] [offsets (compute-offsets types alignment)] - [len (length types)]) + [len (add1 (length types))] + [types (cons type types)]) (make-ctype stype (lambda (vals) (unless (list? vals) @@ -1588,6 +1589,8 @@ stx xs)) (syntax-case stx () [(_ type ([slot slot-type] ...) . more) + (or (stx-pair? #'type) + (stx-pair? #'(slot ...))) (let-values ([(_TYPE _SUPER) (syntax-case #'type () [(t s) (values #'t #'s)] @@ -1629,13 +1632,13 @@ #'x)] [else (err "bad syntax")]))]) (unless (identifier? _TYPE) - (err "bad type, expecting a _name identifier or (_name super-ctype)" + (err "expecting a `_name' identifier or `(_name _super-name)'" _TYPE)) (unless (regexp-match? #rx"^_." (symbol->string (syntax-e _TYPE))) (err "cstruct name must begin with a `_'" _TYPE)) (for ([s (in-list (syntax->list #'(slot ...)))]) (unless (identifier? s) - (err "bad field name, expecting an identifier identifier" s))) + (err "bad field name, expecting an identifier" s))) (if _SUPER (make-syntax _TYPE #t #`(#,(datum->syntax _TYPE 'super _TYPE) slot ...) @@ -1646,13 +1649,16 @@ no-equal?) (make-syntax _TYPE #f #'(slot ...) #`(slot-type ...) alignment properties property-bindings no-equal?)))] + [(_ type () . more) + (identifier? #'type) + (err "must have either a supertype or at least one field")] ;; specific errors for bad slot specs, leave the rest for a generic error [(_ type (bad ...) . more) - (err "bad slot specification, expecting [name ctype]" + (err "bad field specification, expecting `[name ctype]'" (ormap (lambda (s) (syntax-case s () [[n ct] #t] [_ s])) (syntax->list #'(bad ...))))] [(_ type bad . more) - (err "bad slot specification, expecting a sequence of [name ctype]" + (err "bad field specification, expecting a sequence of `[name ctype]'" #'bad)])) ;; Add `prop:equal+hash' to use pointer equality diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c index 4c647555e3..2302205ff0 100644 --- a/racket/src/foreign/foreign.c +++ b/racket/src/foreign/foreign.c @@ -1281,7 +1281,7 @@ static Scheme_Object *foreign_make_cstruct_type(int argc, Scheme_Object *argv[]) int i, nargs, with_alignment; ffi_abi abi; nargs = scheme_proper_list_length(argv[0]); - if (nargs < 0) scheme_wrong_contract(MYNAME, "list?", 0, argc, argv); + if (nargs <= 0) scheme_wrong_contract(MYNAME, "(non-empty-listof ctype?)", 0, argc, argv); abi = GET_ABI(MYNAME,1); if (argc > 2) { if (!SCHEME_FALSEP(argv[2])) { @@ -1301,7 +1301,7 @@ static Scheme_Object *foreign_make_cstruct_type(int argc, Scheme_Object *argv[]) elements[nargs] = NULL; for (i=0, p=argv[0]; i 2) { if (!SCHEME_FALSEP(argv[2])) { @@ -1127,7 +1127,7 @@ static void wrong_void(const char *who, Scheme_Object *list_element, int specifi elements[nargs] = NULL; for (i=0, p=argv[0]; i