~ chicken-core (chicken-5) /tests/symbolgc-tests.scm

 1;;;; symbolgc-tests.scm
 2
 3(import (chicken gc) (chicken format) (chicken keyword))
 4
 5;; Ensure counts are defined before creating the disposable symbols.
 6;; This way, this program can also be run in interpreted mode.
 7(define *count-before* #f)
 8(define *count-after* #f)
 9
10;; Force major GC to ensure there are no collectible symbols left
11;; before we start, otherwise the GC might clean these up and we'd end
12;; up with less symbols than we started with!
13(gc #t)
14
15(set! *count-before* (vector-ref (##sys#symbol-table-info) 2))
16
17(print "starting with " *count-before* " symbols")
18
19(print "interning 10000 symbols ...")
20
21(do ((i 10000 (sub1 i)))
22    ((zero? i))
23  (string->symbol (sprintf "%%%~a%%%" i)))
24
25(print "recovering ...")
26
27;; Force major GC, which should reclaim every last symbol we just
28;; created, as well as "i", the loop counter.
29(gc #t)
30
31;; Don't use LET, which would introduce a fresh identifier, which is a
32;; new symbol (at least, in interpreted mode)
33(set! *count-after* (vector-ref (##sys#symbol-table-info) 2))
34(print (- *count-after* *count-before*) " newly interned symbols left")
35(unless (= *count-after* *count-before*)
36  (error "unable to reclaim all symbols"))
37
38(print "interning 10000 keywords ...")
39
40(do ((i 10000 (sub1 i)))
41    ((zero? i))
42  (string->keyword (sprintf "kw-%%%~a%%%" i)))
43
44(print "recovering ...")
45(gc #t)
46(set! *count-after* (vector-ref (##sys#symbol-table-info) 2))
47(print* (- *count-after* *count-before*) " newly interned leywords left")
48(unless (= *count-after* *count-before*)
49  (error "unable to reclaim all keywords"))
50
51(print "\ndone.")