From f08607509307df553b758a7ef04401118613bb36 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 28 Aug 2020 14:26:50 -0600 Subject: [PATCH] ffi/unsafe: fix `_bitmask` in non-application position The exported `_bitmask` is a macro that picks up a compile-time name when available, but the macro expanded inconsistently. Closes #3367 --- pkgs/racket-test-core/tests/racket/foreign-test.rktl | 4 ++++ racket/collects/ffi/unsafe.rkt | 8 +++++--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 8dcf59a23b..80fe63adce 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -157,6 +157,10 @@ (check s 'c 14) (check s 'd 16)) +(let ([_bm _bitmask]) + (let ([s (_bm '(a b c = 14 d))]) + (test 2 values (cast 'b s _int)))) + (let () (define _test32_enum (_enum `(TEST32 = 1073741906) _sint32)) (define _test64_enum (_enum `(TEST64 = 4611686018427387904) _sint64)) diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 3723330e5e..31b59b0c4e 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -964,8 +964,7 @@ ;; the above with '= -- but the numbers have to be specified in some way. The ;; generated type will convert a list of these symbols into the logical-or of ;; their values and back. -(define (_bitmask name orig-s->i . base?) - (define basetype (if (pair? base?) (car base?) _uint)) +(define (_bitmask/named name orig-s->i [basetype _uint]) (define s->c (if name (string->symbol (format "bitmask:~a->int" name)) 'bitmask->int)) (define symbols->integers @@ -1005,12 +1004,15 @@ (cons (caar s->i) l) l))))))))) +(define (_bitmask orig-s->i [base _uint]) + (_bitmask/named #f orig-s->i base)) + ;; Macro wrapper -- no need for a name (provide (rename-out [_bitmask* _bitmask])) (define-syntax (_bitmask* stx) (syntax-case stx () [(_ x ...) - (with-syntax ([name (syntax-local-name)]) #'(_bitmask 'name x ...))] + (with-syntax ([name (syntax-local-name)]) #'(_bitmask/named 'name x ...))] [id (identifier? #'id) #'_bitmask])) ;; ----------------------------------------------------------------------------