suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make define-cpointer-type declare its function with an inferred-name.

Browse Source 
Closes PR 12296.
This commit is contained in:
Eric Dobson 2015-03-08 10:21:54 -07:00 committed by Matthew Flatt
parent 5895eabad1
commit acd1fe7f8d
2 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -929,6 +929,10 @@
(require (only-in 'mod-cstruct-serialize)) (require (only-in 'mod-cstruct-serialize))
;; ----------------------------------------
(define-cpointer-type _foo)
(test 'foo? object-name foo?)
;; ---------------------------------------- ;; ----------------------------------------

6
racket/collects/ffi/unsafe.rkt
View File

@ -1294,10 +1294,12 @@
[_TYPE/null (id "_" name "/null")]) [_TYPE/null (id "_" name "/null")])
#'(define-values (_TYPE _TYPE/null TYPE? TYPE-tag) #'(define-values (_TYPE _TYPE/null TYPE? TYPE-tag)
(let ([TYPE-tag 'TYPE]) (let ([TYPE-tag 'TYPE])
;; Make the predicate function have the right inferred name
(define (TYPE? x)
(and (cpointer? x) (cpointer-has-tag? x TYPE-tag)))
(values (_cpointer TYPE-tag ptr-type scheme->c c->scheme) (values (_cpointer TYPE-tag ptr-type scheme->c c->scheme)
(_cpointer/null TYPE-tag ptr-type scheme->c c->scheme) (_cpointer/null TYPE-tag ptr-type scheme->c c->scheme)
(lambda (x) TYPE?
(and (cpointer? x) (cpointer-has-tag? x TYPE-tag)))
TYPE-tag)))))])) TYPE-tag)))))]))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------