summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-01-23 23:51:33 +0100
committerLudovic Courtès <ludo@gnu.org>2012-01-23 23:51:33 +0100
commit5765c5a82ce3891faff02c0bcc603cc0fe5ae36d (patch)
treeffd79f59e8e979194ed126c181998e9cf3bbf6f5
parentc64d07d822f44f5917ee9b90956bb8ed5bb716fd (diff)
downloadguile-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.c2
-rw-r--r--test-suite/tests/foreign.test8
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)))))