~ chicken-core (chicken-5) /tests/test-finalizers.scm

 1;;;; test-finalizers.scm
 2
 3;; NOTE: This may fail, reopen #1426 if it does
 4
 5(import (chicken format))
 6(import (chicken gc))
 7
 8(##sys#eval-debug-level 0)		; disable keeping trace-buffer with frameinfo
 9
10(define x (list 1 2 3))
11(define y (list 4 5 6))
12(define x-f #f)
13(define y-f #f)
14
15(begin
16  (set-finalizer! 
17   x
18   (lambda (o)
19     (format #t "Delete: ~A (y: ~a)~%" o y-f)
20     (set! x-f #t)))
21  #t) 
22(begin 
23  (set-finalizer! 
24   y 
25   (let ((p x))
26     (lambda (o)
27       (format #t "Delete: ~A: ~A~%" o p)
28       (set! y-f #t))))
29  #t)
30(gc #t)
31(assert (not x-f))
32
33#|
34
35This ought to work, see patches/finalizer.closures.diff for
36a fix that unfortunately disables finalizers in the interpreter
37(probably due to the different closure representation).
38
39(assert (not y-f))
40(set! x #f)
41(gc #t)
42(assert (not x-f))
43(assert (not y-f))
44(set! y #f)
45(gc #t)
46(assert y-f)
47(assert x-f)
48|#
49
50(define foo-f #f)
51
52(let ((foo (vector 1 2 3)))
53  (set-finalizer! foo (lambda _ (set! foo-f #t)))
54  #t)
55
56(gc #t)
57(assert foo-f)
58
59
60;; double finalizer
61
62(define n 0)
63(define (bump . _) (set! n (add1 n)))
64(define x (vector 1))
65(set-finalizer! x bump)
66(set-finalizer! x bump)
67(set! x #f)
68(gc #t)
69(print n)
70(assert (= 2 n))
71
72;; Finalizers on constants are ignored in compiled mode (because
73;; they're never GCed).  Reported by "Pluijzer".
74
75#| this doesn't always work in csi, for some unknown reason,
76   depending on unrelated factors (command-line options,
77   memory usage patterns, etc.)
78                                                
79(set! n 0)
80(define bar "constant string")
81(set-finalizer! bar bump)
82(set! bar #f)
83(gc #t)
84(print n)
85(cond-expand
86  (compiling (assert (= 0 n)))
87  (else (assert (= 1 n))))
88|#