~ chicken-core (chicken-5) 40160a8dce63228dfdeed8c1e9b742fae59d6c96

commit 40160a8dce63228dfdeed8c1e9b742fae59d6c96
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Dec 10 15:16:03 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Dec 10 15:16:03 2010 +0100

    finalizers are scanned first, then marked, or the first mark will not trigger a finalizer for the same object

diff --git a/runtime.c b/runtime.c
index 61efe5eb..ca3392b0 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2809,12 +2809,16 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void *proc)
       else {
 	j = fcount = 0;
 
+	/* move into pending */
 	for(flist = finalizer_list; flist != NULL; flist = flist->next) {
 	  if(j < C_max_pending_finalizers) {
 	    if(!is_fptr(C_block_header(flist->item))) 
 	      pending_finalizer_indices[ j++ ] = flist;
 	  }
+	}
 
+	/* mark */
+	for(flist = finalizer_list; flist != NULL; flist = flist->next) {
 	  mark(&flist->item);
 	  mark(&flist->finalizer);
 	}
@@ -2829,7 +2833,7 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void *proc)
       finalizers_checked = 1;
 
       if(pending_finalizer_count > 0 && gc_report_flag)
-	C_dbg(C_text("GC"), C_text("finalizers pending for rescan:\t %d (%d live)\n"), 
+	C_dbg(C_text("GC"), C_text("%d finalizer(s) pending (%d live)\n"), 
 	      pending_finalizer_count, live_finalizer_count);
 
       goto rescan;
@@ -2839,7 +2843,7 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void *proc)
 	 (and release finalizer node): */
       if(pending_finalizer_count > 0) {
 	if(gc_report_flag)
-	  C_dbg(C_text("GC"), C_text("queueing %d finalizers\n"), pending_finalizer_count);
+	  C_dbg(C_text("GC"), C_text("queueing %d finalizer(s)\n"), pending_finalizer_count);
 
 	last = C_block_item(pending_finalizers_symbol, 0);
 	assert(C_u_i_car(last) == C_fix(0));
diff --git a/tests/test-finalizers.scm b/tests/test-finalizers.scm
index 512b0991..6ff33e1d 100644
--- a/tests/test-finalizers.scm
+++ b/tests/test-finalizers.scm
@@ -50,3 +50,16 @@ a fix that unfortunately disables finalizers in the interpreter
 
 (gc #t)
 (assert foo-f)
+
+
+;; double finalizer
+
+(define n 0)
+(define (bump . _) (set! n (add1 n)))
+(define x (vector 1))
+(set-finalizer! x bump)
+(set-finalizer! x bump)
+(set! x #f)
+(gc #t)
+(print n)
+(assert (= 2 n))