Commit | Line | Data |
---|---|---|
53a53bd7 | 1 | ;;;; gc.test --- test guile's garbage collection -*- scheme -*- |
1e2b4920 | 2 | ;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009, |
a2b62b48 | 3 | ;;;; 2011, 2012 Free Software Foundation, Inc. |
53a53bd7 | 4 | ;;;; |
73be1d9e MV |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
73be1d9e MV |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
53a53bd7 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
53a53bd7 | 18 | |
fb135e12 AW |
19 | (define-module (test-suite tests gc) |
20 | #:use-module (ice-9 documentation) | |
21 | #:use-module (test-suite lib) | |
22 | #:use-module ((system base compile) #:select (compile))) | |
53a53bd7 DH |
23 | |
24 | ||
25 | ;;; | |
26 | ;;; miscellaneous | |
27 | ;;; | |
28 | ||
29 | ||
30 | (define (documented? object) | |
5c96bc39 | 31 | (not (not (object-documentation object)))) |
53a53bd7 | 32 | |
155c14a0 KR |
33 | ;; In guile 1.6.4 this test bombed, due to the record in h being collected |
34 | ;; by the gc, but not removed from h, leaving "x" as a freed cell. | |
35 | ;; The usual correct result here is for x to be #f, but there's always a | |
36 | ;; chance gc will mark something used when it isn't, so we allow x to be a | |
37 | ;; record too. | |
38 | (pass-if "weak-values versus records" | |
39 | (let ((rec-type (make-record-type "foo" '())) | |
40 | (h (make-weak-value-hash-table 61))) | |
41 | (hash-set! h "foo" ((record-constructor rec-type))) | |
42 | (gc) | |
43 | (let ((x (hash-ref h "foo"))) | |
44 | (or (not x) | |
45 | ((record-predicate rec-type) x))))) | |
46 | ||
53a53bd7 DH |
47 | |
48 | ;;; | |
49 | ;;; | |
50 | ;;; | |
51 | ||
1e2b4920 LC |
52 | (define (stack-cleanup depth) |
53 | ;; Clean up stack space for DEPTH words. This is defined here so that | |
54 | ;; `peval' doesn't inline it. | |
55 | (let cleanup ((i depth)) | |
56 | (and (> i 0) | |
57 | (begin (cleanup (1- i)) i)))) | |
58 | ||
53a53bd7 DH |
59 | (with-test-prefix "gc" |
60 | ||
61 | (pass-if "after-gc-hook gets called" | |
62 | (let* ((foo #f) | |
63 | (thunk (lambda () (set! foo #t)))) | |
64 | (add-hook! after-gc-hook thunk) | |
65 | (gc) | |
66 | (remove-hook! after-gc-hook thunk) | |
fb135e12 | 67 | foo)) |
e4da0740 | 68 | |
e4da0740 | 69 | (pass-if "Unused modules are removed" |
9035e9d6 LC |
70 | (let* ((guard (make-guardian)) |
71 | (total 1000)) | |
328efeb9 | 72 | |
9035e9d6 | 73 | (for-each (lambda (x) (guard (make-module))) (iota total)) |
f937ce37 | 74 | |
9035e9d6 | 75 | ;; Avoid false references to the modules on the stack. |
1e2b4920 | 76 | (stack-cleanup 20) |
5f161164 | 77 | |
9035e9d6 | 78 | (gc) |
fb135e12 AW |
79 | (gc) ;; twice: have to kill the weak vectors. |
80 | (gc) ;; thrice: because the test doesn't succeed with only | |
81 | ;; one gc round. not sure why. | |
9035e9d6 LC |
82 | |
83 | (= (let lp ((i 0)) | |
84 | (if (guard) | |
85 | (lp (1+ i)) | |
86 | i)) | |
fb135e12 AW |
87 | total))) |
88 | ||
89 | (pass-if "Lexical vars are collectable" | |
a2b62b48 | 90 | (list? |
fb135e12 AW |
91 | (compile |
92 | '(begin | |
93 | (define guardian (make-guardian)) | |
a2b62b48 AW |
94 | (let ((f (list 'foo))) |
95 | ;; Introduce a useless second reference to f to prevent the | |
96 | ;; optimizer from propagating the lexical binding. | |
97 | f | |
fb135e12 AW |
98 | (guardian f)) |
99 | (gc)(gc)(gc) | |
100 | (guardian)))))) |