From ca33b501a93f8de389c1e3e1bc987f63b6912029 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Mar 2011 16:09:55 +0100 Subject: [PATCH] Work around weak-value hash table bug in `define-wrapped-pointer-type'. * module/system/foreign.scm (define-wrapped-pointer-type)[wrap]: Use `hash-ref' and `hash-set!' instead of `hash-create-handle!' and `set-cdr!'. --- module/system/foreign.scm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 781e79369..a657d4460 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -190,9 +190,12 @@ which does the reverse. PRINT must name a user-defined object printer." ;; PTR1 == PTR2 <-> (eq? (wrap PTR1) (wrap PTR2)). (let ((ptr->obj (make-weak-value-hash-table 3000))) (lambda (ptr) - (let ((key+value (hash-create-handle! ptr->obj ptr #f))) - (or (cdr key+value) - (let ((o (%wrap ptr))) - (set-cdr! key+value o) - o)))))) + ;; XXX: We can't use `hash-create-handle!' + + ;; `set-cdr!' here because the former would create a + ;; weak-cdr pair but the latter wouldn't register a + ;; disappearing link (see `scm_hash_fn_set_x'.) + (or (hash-ref ptr->obj ptr) + (let ((o (%wrap ptr))) + (hash-set! ptr->obj ptr o) + o))))) (set-record-type-printer! type-name print)))))))