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

ffi/unsafe/alloc: allow #f as an "allocator"

Browse Source 
Allowing #f as an allocator avoids problems composing `allocator` with
foreign-function lookup where failure is anticipated and implemented
as #f. For example, `g_settings_new` in the "gui-lib" package's
"mred/private/wx/gtk/gsettings.rkt" can be #f if the libgio libray is
too old, in which case there won't be an attempt to use
`g_settings_new`.
This commit is contained in:
Matthew Flatt 2019-08-10 07:23:54 -06:00
parent 19fad3f8d9
commit 001abc5b55
3 changed files with 38 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-doc/scribblings/foreign/alloc.scrbl
View File

@ -9,14 +9,16 @@
ensuring that values allocated through foreign functions are reliably
deallocated.}
@defproc[((allocator [dealloc (any/c . -> . any)]) [alloc procedure?]) procedure?]{
@defproc[((allocator [dealloc (any/c . -> . any)]) [alloc (or/c procedure? #f)]) (or/c procedure? #f)]{
Produces an @deftech{allocator} procedure that behaves like
@racket[alloc], but each result @racket[_v] of the @tech{allocator},
if not @racket[#f], is given a finalizer that calls @racket[dealloc]
on @racket[_v] --- unless the call has been canceled by applying a
on @racket[_v]---unless the call has been canceled by applying a
@tech{deallocator} (produced by @racket[deallocator]) to @racket[_v].
Any existing @racket[dealloc] registered for @racket[_v] is canceled.
If and only if @racket[alloc] is @racket[#f], @racket[((allocator
alloc) dealloc)] produces @racket[#f].
The resulting @tech{allocator} calls @racket[alloc] in @tech{atomic
mode} (see @racket[call-as-atomic]). The result from @racket[alloc] is
@ -44,7 +46,9 @@ a new deallocation action that will run earlier.
@history[#:changed "7.0.0.4" @elem{Added atomic mode for @racket[dealloc]
and changed non-main place exits to call
all remaining @racket[dealloc]s.}]}
all remaining @racket[dealloc]s.}
#:changed "7.4.0.4" @elem{Produce @racket[#f] when @racket[alloc]
is @racket[#f].}]}
@deftogether[(
@defproc[((deallocator [get-arg (list? . -> . any/c) car]) [dealloc procedure?])

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

@ -5,6 +5,7 @@
(require ffi/unsafe
ffi/unsafe/cvector
ffi/unsafe/alloc
ffi/unsafe/define
ffi/unsafe/define/conventions
ffi/vector
@ -1302,6 +1303,11 @@
;; ----------------------------------------
(test #t procedure? ((allocator void) void))
(test #f (allocator void) #f)
;; ----------------------------------------
;; Check `void/reference-sink`
(let* ([sym (gensym)]
[wb (make-weak-box sym)])

47
racket/collects/ffi/unsafe/alloc.rkt
View File

@ -61,28 +61,31 @@
(define ((allocator d) proc)
(check-arity-includes-1 'allocator d)
(rename
(let-values ([(_ allowed-kws) (procedure-keywords proc)])
(define (register v)
(when v
(define ds (node (make-late-weak-box v) d #f #f #f))
(add-node! ds)
(hash-set! allocated v ds)
(register-finalizer v deallocate))
v)
(cond
[(null? allowed-kws)
(lambda args
(call-as-atomic
(lambda ()
(register (apply proc args)))))]
[else
(make-keyword-procedure
(λ (kws kw-args . rest)
(call-as-atomic
(lambda ()
(register (keyword-apply proc kws kw-args rest))))))]))
proc))
(cond
[(not proc) #f]
[else
(rename
(let-values ([(_ allowed-kws) (procedure-keywords proc)])
(define (register v)
(when v
(define ds (node (make-late-weak-box v) d #f #f #f))
(add-node! ds)
(hash-set! allocated v ds)
(register-finalizer v deallocate))
v)
(cond
[(null? allowed-kws)
(lambda args
(call-as-atomic
(lambda ()
(register (apply proc args)))))]
[else
(make-keyword-procedure
(λ (kws kw-args . rest)
(call-as-atomic
(lambda ()
(register (keyword-apply proc kws kw-args rest))))))]))
proc)]))
(define ((deallocator [get-arg car]) proc)
(check-arity-includes-1 'deallocator get-arg "(-> list/c any/c)")