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

repair for define-cpointer-type

Browse Source
This commit is contained in:
Matthew Flatt 2016-07-01 09:08:35 -06:00
parent 762994654c
commit e92b07728f
2 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1021,6 +1021,13 @@
(define-cpointer-type _foo) (define-cpointer-type _foo)
(test 'foo? object-name foo?) (test 'foo? object-name foo?)
(define-cpointer-type _also_foo #f #f (lambda (ptr)
(cpointer-push-tag! ptr 'extra)
ptr))
(let ([p (cast (malloc 16) _pointer _also_foo)])
(test #t also_foo? p)
(test #t cpointer-has-tag? p 'extra))
;; ---------------------------------------- ;; ----------------------------------------
;; Test JIT inlining ;; Test JIT inlining

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

@ -1356,7 +1356,7 @@
[(_ _TYPE #:tag the-tag) #'(define-cpointer-type _TYPE #f #f #f #:tag the-tag)] [(_ _TYPE #:tag the-tag) #'(define-cpointer-type _TYPE #f #f #f #:tag the-tag)]
[(_ _TYPE ptr-type) #'(define-cpointer-type _TYPE ptr-type #f #f #:tag #f)] [(_ _TYPE ptr-type) #'(define-cpointer-type _TYPE ptr-type #f #f #:tag #f)]
[(_ _TYPE ptr-type #:tag the-tag) #'(define-cpointer-type _TYPE ptr-type #f #f #:tag the-tag)] [(_ _TYPE ptr-type #:tag the-tag) #'(define-cpointer-type _TYPE ptr-type #f #f #:tag the-tag)]
[(_ _TYPE ptr-type scheme->c c->scheme) #'(define-cpointer-type _TYPE ptr-type #f #f #:tag #f)] [(_ _TYPE ptr-type scheme->c c->scheme) #'(define-cpointer-type _TYPE ptr-type scheme->c c->scheme #:tag #f)]
[(_ _TYPE ptr-type scheme->c c->scheme #:tag the-tag) [(_ _TYPE ptr-type scheme->c c->scheme #:tag the-tag)
(and (identifier? #'_TYPE) (and (identifier? #'_TYPE)
(regexp-match #rx"^_.+" (symbol->string (syntax-e #'_TYPE)))) (regexp-match #rx"^_.+" (symbol->string (syntax-e #'_TYPE))))