Add missing fender to define-cstruct

prevents internal error from libffi for
(define-cstruct _S ())

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:
 

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

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<nargs; i++, p=SCHEME_CDR(p)) {
     if (NULL == (base = get_ctype_base(SCHEME_CAR(p))))
-      scheme_wrong_contract(MYNAME, "(listof ctype?)", 0, argc, argv);
+      scheme_wrong_contract(MYNAME, "(non-empty-listof ctype?)", 0, argc, argv);
     if (CTYPE_PRIMLABEL(base) == FOREIGN_void)
       wrong_void(MYNAME, SCHEME_CAR(p), 1, 0, argc, argv);
     elements[i] = CTYPE_PRIMTYPE(base);

racket/src/foreign/foreign.rktc

@@ -1107,7 +1107,7 @@ static void wrong_void(const char *who, Scheme_Object *list_element, int specifi
   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])) {
@@ -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<nargs; i++, p=SCHEME_CDR(p)) {
     if (NULL == (base = get_ctype_base(SCHEME_CAR(p))))
-      scheme_wrong_contract(MYNAME, "(listof ctype?)", 0, argc, argv);
+      scheme_wrong_contract(MYNAME, "(non-empty-listof ctype?)", 0, argc, argv);
     if (CTYPE_PRIMLABEL(base) == FOREIGN_void)
       wrong_void(MYNAME, SCHEME_CAR(p), 1, 0, argc, argv);
     elements[i] = CTYPE_PRIMTYPE(base);