From ad899173b97ce2ca51612a496d17ea32db45ecdc Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Tue, 17 Mar 2015 23:13:04 -0700
Subject: [PATCH] Add more error checking to _enum.

This also fixes some tests which were not running.
---
 .../tests/racket/foreign-test.rktl            | 26 +++++++++++++------
 racket/collects/ffi/unsafe.rkt                | 19 ++++++++++++--
 2 files changed, 35 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl
index 27ab1895d5..3a411f43df 100644
--- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl
+++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl
@@ -134,25 +134,35 @@
 (test 21 ctype-sizeof (_array _byte 3 7))
 
 ;; Test enum and bitmask
-(define ([t (_enum '(a b c = 4 d))]
-         [s (_bitmask '(a b c = 14 d))])
+(let ([t (_enum '(a b c = 4 d))]
+      [s (_bitmask '(a b c = 14 d))])
   (define (check t v n)
-    (test n (cast v t _int)))
+    (test #t (λ (x) (equal? x n)) (cast v t _int)))
   (check t 'a 0)
   (check t 'b 1)
   (check t 'c 4)
   (check t 'd 5)
-  (check t 'a 1)
-  (check t 'b 2)
-  (check t 'c 14)
-  (check t 'd 16)
-  (check t '(a b) 3))
+  (check s 'a 1)
+  (check s 'b 2)
+  (check s 'c 14)
+  (check s 'd 16))
 
 ;; Make sure `_box` at least compiles:
 (test #t ctype? (_fun (_box _int) -> _void))
 
+;; Check error message on bad _fun form
+(syntax-test #'(_fun (b) :: _bool -> _void) #rx"unnamed argument .without an expression. is not allowed")
+
 ;; Make sure that _enum works in non first order cases
 (test #t ctype? (let ([enum _enum]) (enum '(x y))))
+;; Make sure that _enum checks its inputs
+(let ([_enum-exn? (lambda (exn)
+                    (and (exn:fail:contract? exn)
+                         (regexp-match? #rx"_enum" (exn-message exn))))])
+  (error-test #'(_enum 1) _enum-exn?)
+  (error-test #'(_enum '(1)) _enum-exn?)
+  (error-test #'(_enum '(x = y)) _enum-exn?)
+  (error-test #'(_enum '(x y) #:unknown (lambda (x y) x)) _enum-exn?))
 
 (define-cstruct _ic7i ([i1 _int]
                        [c7 _c7_list]
diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt
index f0922fb83d..7f46980e37 100644
--- a/racket/collects/ffi/unsafe.rkt
+++ b/racket/collects/ffi/unsafe.rkt
@@ -797,6 +797,10 @@
 ;; Call this with a name (symbol or #f) and a list of symbols, where a symbol can be
 ;; followed by a '= and an integer to have a similar effect of C's enum.
 (define ((_enum name) symbols [basetype _ufixint] #:unknown [unknown _enum])
+  (unless (list? symbols)
+    (raise-argument-error '_enum "list?" symbols))
+  (when (and (procedure? unknown) (not (procedure-arity-includes? unknown 1)))
+    (raise-argument-error '_enum "(if/c procedure? (procedure-arity-includes/c 1) any/c)" unknown))
   (define sym->int '())
   (define int->sym '())
   (define s->c
@@ -810,8 +814,19 @@
                                       (pair? (cddr symbols)))
                                (values (caddr symbols) (cdddr symbols))
                                (values i (cdr symbols)))])
-        (set! sym->int (cons (cons (car symbols) i) sym->int))
-        (set! int->sym (cons (cons i (car symbols)) int->sym))
+        (define sym (car symbols))
+        (unless (symbol? sym)
+          (raise-arguments-error '_enum "key is not a symbol"
+                                 "symbols" symbols
+                                 "key" sym
+                                 "value" i))
+        (unless (exact-nonnegative-integer? i)
+          (raise-arguments-error '_enum "value is not an integer"
+                                 "symbols" symbols
+                                 "key" sym
+                                 "value" i))
+        (set! sym->int (cons (cons sym i) sym->int))
+        (set! int->sym (cons (cons i sym) int->sym))
         (loop (add1 i) rest))))
   (make-ctype basetype
     (lambda (x)