Commit | Line | Data |
---|---|---|
53a53bd7 | 1 | ;;;; gc.test --- test guile's garbage collection -*- scheme -*- |
0a9a6d14 | 2 | ;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
53a53bd7 | 3 | ;;;; |
73be1d9e MV |
4 | ;;;; This library is free software; you can redistribute it and/or |
5 | ;;;; modify it under the terms of the GNU Lesser General Public | |
6 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 7 | ;;;; version 3 of the License, or (at your option) any later version. |
73be1d9e MV |
8 | ;;;; |
9 | ;;;; This library is distributed in the hope that it will be useful, | |
53a53bd7 | 10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;;;; Lesser General Public License for more details. | |
13 | ;;;; | |
14 | ;;;; You should have received a copy of the GNU Lesser General Public | |
15 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 16 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
53a53bd7 | 17 | |
155c14a0 KR |
18 | (use-modules (ice-9 documentation) |
19 | (test-suite lib)) | |
53a53bd7 DH |
20 | |
21 | ||
22 | ;;; | |
23 | ;;; miscellaneous | |
24 | ;;; | |
25 | ||
26 | ||
27 | (define (documented? object) | |
5c96bc39 | 28 | (not (not (object-documentation object)))) |
53a53bd7 | 29 | |
155c14a0 KR |
30 | ;; In guile 1.6.4 this test bombed, due to the record in h being collected |
31 | ;; by the gc, but not removed from h, leaving "x" as a freed cell. | |
32 | ;; The usual correct result here is for x to be #f, but there's always a | |
33 | ;; chance gc will mark something used when it isn't, so we allow x to be a | |
34 | ;; record too. | |
35 | (pass-if "weak-values versus records" | |
36 | (let ((rec-type (make-record-type "foo" '())) | |
37 | (h (make-weak-value-hash-table 61))) | |
38 | (hash-set! h "foo" ((record-constructor rec-type))) | |
39 | (gc) | |
40 | (let ((x (hash-ref h "foo"))) | |
41 | (or (not x) | |
42 | ((record-predicate rec-type) x))))) | |
43 | ||
53a53bd7 DH |
44 | |
45 | ;;; | |
46 | ;;; | |
47 | ;;; | |
48 | ||
49 | (with-test-prefix "gc" | |
50 | ||
51 | (pass-if "after-gc-hook gets called" | |
52 | (let* ((foo #f) | |
53 | (thunk (lambda () (set! foo #t)))) | |
54 | (add-hook! after-gc-hook thunk) | |
55 | (gc) | |
56 | (remove-hook! after-gc-hook thunk) | |
57 | foo))) | |
e4da0740 HWN |
58 | |
59 | ||
60 | (with-test-prefix "gc" | |
61 | (pass-if "Unused modules are removed" | |
328efeb9 LC |
62 | (let* ((guard (make-guardian)) |
63 | (total 1000)) | |
64 | ||
65 | (for-each (lambda (x) (guard (make-module))) (iota total)) | |
f937ce37 LC |
66 | |
67 | ;; XXX: This hack aims to clean up the stack to make sure we | |
68 | ;; don't leave a reference to one of the modules we created. It | |
69 | ;; proved to be useful on SPARC: | |
70 | ;; http://lists.gnu.org/archive/html/guile-devel/2008-02/msg00006.html . | |
0a9a6d14 | 71 | (let cleanup ((i 20)) |
f937ce37 LC |
72 | (and (> i 0) |
73 | (begin (cleanup (1- i)) i))) | |
74 | ||
e4da0740 HWN |
75 | (gc) |
76 | (gc) ;; twice: have to kill the weak vectors. | |
328efeb9 LC |
77 | (= (length (filter (lambda (x) |
78 | (eq? x #t)) | |
79 | (map (lambda (x) (and (guard) #t)) | |
80 | (iota total)))) | |
81 | total)))) |