From acd1fe7f8d959f6c5aa525e85c429ce673c41d37 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sun, 8 Mar 2015 10:21:54 -0700 Subject: [PATCH] Make define-cpointer-type declare its function with an inferred-name. Closes PR 12296. --- pkgs/racket-test-core/tests/racket/foreign-test.rktl | 4 ++++ racket/collects/ffi/unsafe.rkt | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 08c10b11fe..64a6cf7dc3 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -929,6 +929,10 @@ (require (only-in 'mod-cstruct-serialize)) +;; ---------------------------------------- + +(define-cpointer-type _foo) +(test 'foo? object-name foo?) ;; ---------------------------------------- diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index bb410f776f..77027f93ce 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -1294,10 +1294,12 @@ [_TYPE/null (id "_" name "/null")]) #'(define-values (_TYPE _TYPE/null TYPE? TYPE-tag) (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) (_cpointer/null TYPE-tag ptr-type scheme->c c->scheme) - (lambda (x) - (and (cpointer? x) (cpointer-has-tag? x TYPE-tag))) + TYPE? TYPE-tag)))))])) ;; ----------------------------------------------------------------------------