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

 1;;;; finalizer-error-test.scm - by "megane"
 2
 3(import (chicken gc))
 4
 5(define n 10000)
 6
 7(define (make-objects n)
 8  (let loop [(i 0)]
 9    (let [(o (make-vector 100))]
10      ;(print "making " i)
11      (set-finalizer! o (lambda (ob) (print* " " i)))
12      (if (< i n)
13	  (loop (+ 1 i))))))
14
15(set-finalizer! (make-vector 100) (lambda (ob) (+ i 'a)))
16
17(make-objects n)
18
19(print "done")