diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-01-23 23:51:33 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-01-23 23:51:33 +0100 |
commit | 5765c5a82ce3891faff02c0bcc603cc0fe5ae36d (patch) | |
tree | ffd79f59e8e979194ed126c181998e9cf3bbf6f5 | |
parent | c64d07d822f44f5917ee9b90956bb8ed5bb716fd (diff) | |
download | guile-5765c5a82ce3891faff02c0bcc603cc0fe5ae36d.tar.gz |
FFI: Fix `set-pointer-finalizer!' to leave the type cell unchanged.
This is a followup to 690a0112e55823aa8b862daeddcf44cea97e7917 ("Remove
the "has finalizer?" bit from pointer objects.")
* libguile/foreign.c (scm_set_pointer_finalizer_x): Leave the type cell
unchanged. Before, `equal?' would break on pointers on which
`set-pointer-finalizer!' had been called.
* test-suite/tests/foreign.test ("make-pointer")["equal? modulo
finalizer (set-pointer-finalizer!)"]: New test.
-rw-r--r-- | libguile/foreign.c | 2 | ||||
-rw-r--r-- | test-suite/tests/foreign.test | 8 |
2 files changed, 7 insertions, 3 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index f8c268d51..0dc7ac666 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -319,8 +319,6 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0, c_finalizer = SCM_POINTER_VALUE (finalizer); - SCM_SET_CELL_WORD_0 (pointer, SCM_CELL_WORD_0 (pointer) | (1 << 16UL)); - GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer), pointer_finalizer_trampoline, c_finalizer, diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 2c326c98e..6eafe954a 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -1,6 +1,6 @@ ;;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -71,6 +71,12 @@ (equal? (make-pointer 123) (make-pointer 123 finalizer)))) + (pass-if "equal? modulo finalizer (set-pointer-finalizer!)" + (let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link))) + (ptr (make-pointer 123))) + (set-pointer-finalizer! ptr finalizer) + (equal? (make-pointer 123) ptr))) + (pass-if "not equal?" (not (equal? (make-pointer 123) (make-pointer 456))))) |