From 1149d6cdcd54685730da7a412c3e0c53166c7edc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 10 May 2016 10:51:45 -0600 Subject: [PATCH] ffi/unsafe: add checking of _array values When an array value is provided, make sure that it's an array with at least the expected length (or longer) and same element layout. That's weaker than checking that the array elements have the right type, because an `eq?` check at the ctype layer seems too strong, and the ctype API doesn't provide enough information for a more flexible equality. --- .../scribblings/foreign/types.scrbl | 9 ++++++- .../tests/racket/foreign-test.rktl | 10 ++++++- racket/collects/ffi/unsafe.rkt | 26 ++++++++++++++++--- 3 files changed, 39 insertions(+), 6 deletions(-) diff --git a/pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-doc/scribblings/foreign/types.scrbl index 2b01f8a562..e9f52a99a4 100644 --- a/pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -1375,7 +1375,14 @@ representation. Supply multiple @racket[count]s for a multidimensional array. Since C uses row-major order for arrays, @racket[(_array _t _n _m)] is equivalent to @racket[(_array (_array _t _m) _n)], which is different -from an array of pointers to arrays.} +from an array of pointers to arrays. + +When a value is used as an instance of an array type (e.g., as passed +to a foreign function), checking ensures that the given value is an +array of at least the expected length and whose elements have the same +representation according to @racket[ctype->layout]; the array can have +additional elements, and it can have a different element type as long +as that type matches the layout of the expected type.} @defproc[(array? [v any/c]) boolean?]{ diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index cf620e5d72..0398e0cb83 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -331,7 +331,15 @@ (test 7 array-length a) (test 12 array-ref a 1) (ptr-set! p _byte 1 17) - (test 17 array-ref a 1))) + (test 17 array-ref a 1) + (test #t array? (cast a (_array _byte 7) (_array _ubyte 7))) + (test #t array? (cast a (_array _byte 6) (_array _ubyte 6))) ; smaller is ok + (err/rt-test (cast a (_array _byte 8) (_array _ubyte 8)) + (lambda (exn) (regexp-match? "array length does not match" (exn-message exn)))))) + (let ([a (ptr-ref (malloc (_array (_array _int 2) 3)) (_array (_array _int 2) 3))]) + (test #t array? (cast a (_array (_array _int 2) 2) (_array (_array _uint 2) 2))) ; smaller outside is ok + (err/rt-test (cast a (_array (_array _int 1) 3) (_array (_array _uint 1) 3)) ; smaller inside is not ok + (lambda (exn) (regexp-match? "array element type is incompatible" (exn-message exn))))) ;; Disable these tests on Windows/i386 where they fail (and crash the process ;; killing all other tests). Matthew said: There's no consistent spec for ;; functions that return structures in i386 Windows. Historically, gcc does diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 58dc55fd7d..4d8f293bb9 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -1067,7 +1067,22 @@ (case-lambda [(t n) (make-ctype (make-array-type t n) - (lambda (v) (array-ptr v)) + (lambda (v) + (unless (array? v) + (raise-argument-error '_array "array?" v)) + (unless (or (eq? (array-type v) t) ; common case + ;; For the more general case, we'd like to make sure the + ;; types match, but the ctype API isn't reflective enough; + ;; we approximate by checking representations: + (equal? (ctype->layout (array-type v)) (ctype->layout t))) + (raise-arguments-error '_array "array element type is incompatible" + "expected element representation" (ctype->layout t) + "given value's element representation" (ctype->layout (array-type v)))) + (unless ((array-length v) . >= . n) + (raise-arguments-error '_array "array length does not match" + "expected minimum length" n + "given value's length" (array-length v))) + (array-ptr v)) (lambda (v) (make-array v t n)))] [(t n . ns) (_array (apply _array t ns) n)])) @@ -1321,9 +1336,12 @@ (define (ctype-coretype c) (let loop ([c (ctype-basetype c)]) - (if (symbol? c) - c - (loop (ctype-basetype c))))) + (cond + [(symbol? c) c] + [(vector? c) 'array] + [(list? c) 'struct] + [else + (loop (ctype-basetype c))]))) ;; A macro version of the above two functions, using the defined name for a tag ;; string, and defining a predicate too. The name should look like `_foo', the