Commit | Line | Data |
---|---|---|
53a53bd7 | 1 | ;;;; gc.test --- test guile's garbage collection -*- scheme -*- |
1e2b4920 | 2 | ;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009, |
86fafc44 | 3 | ;;;; 2011, 2012, 2013 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 | |
d10f7b57 | 19 | (define-module (tests gc) |
fb135e12 AW |
20 | #:use-module (ice-9 documentation) |
21 | #:use-module (test-suite lib) | |
22 | #:use-module ((system base compile) #:select (compile))) | |
53a53bd7 DH |
23 | |
24 | ||
52de2ab4 AW |
25 | ;; Some of these tests verify that things are collectable. As we use a |
26 | ;; third-party conservative collector, we really can't guarantee that -- | |
27 | ;; we can try, but on some platforms, on some versions (possibly), the | |
28 | ;; test might fail. But we don't want that to stop the build. So, | |
29 | ;; instead of failing, throw 'unresolved. | |
30 | ;; | |
31 | (define (maybe-gc-flakiness result) | |
32 | (or result | |
33 | (throw 'unresolved))) | |
34 | ||
53a53bd7 DH |
35 | ;;; |
36 | ;;; miscellaneous | |
37 | ;;; | |
38 | ||
39 | ||
40 | (define (documented? object) | |
5c96bc39 | 41 | (not (not (object-documentation object)))) |
53a53bd7 | 42 | |
155c14a0 KR |
43 | ;; In guile 1.6.4 this test bombed, due to the record in h being collected |
44 | ;; by the gc, but not removed from h, leaving "x" as a freed cell. | |
45 | ;; The usual correct result here is for x to be #f, but there's always a | |
46 | ;; chance gc will mark something used when it isn't, so we allow x to be a | |
47 | ;; record too. | |
48 | (pass-if "weak-values versus records" | |
49 | (let ((rec-type (make-record-type "foo" '())) | |
50 | (h (make-weak-value-hash-table 61))) | |
51 | (hash-set! h "foo" ((record-constructor rec-type))) | |
52 | (gc) | |
53 | (let ((x (hash-ref h "foo"))) | |
54 | (or (not x) | |
55 | ((record-predicate rec-type) x))))) | |
56 | ||
53a53bd7 DH |
57 | |
58 | ;;; | |
59 | ;;; | |
60 | ;;; | |
61 | ||
62 | (with-test-prefix "gc" | |
63 | ||
64 | (pass-if "after-gc-hook gets called" | |
65 | (let* ((foo #f) | |
66 | (thunk (lambda () (set! foo #t)))) | |
67 | (add-hook! after-gc-hook thunk) | |
68 | (gc) | |
69 | (remove-hook! after-gc-hook thunk) | |
fb135e12 | 70 | foo)) |
e4da0740 | 71 | |
e4da0740 | 72 | (pass-if "Unused modules are removed" |
9035e9d6 LC |
73 | (let* ((guard (make-guardian)) |
74 | (total 1000)) | |
328efeb9 | 75 | |
9035e9d6 | 76 | (for-each (lambda (x) (guard (make-module))) (iota total)) |
f937ce37 | 77 | |
9035e9d6 | 78 | ;; Avoid false references to the modules on the stack. |
5270a001 | 79 | (clear-stale-stack-references) |
5f161164 | 80 | |
9035e9d6 | 81 | (gc) |
fb135e12 AW |
82 | (gc) ;; twice: have to kill the weak vectors. |
83 | (gc) ;; thrice: because the test doesn't succeed with only | |
84 | ;; one gc round. not sure why. | |
9035e9d6 | 85 | |
52de2ab4 AW |
86 | (maybe-gc-flakiness |
87 | (= (let lp ((i 0)) | |
88 | (if (guard) | |
89 | (lp (1+ i)) | |
90 | i)) | |
91 | total)))) | |
fb135e12 AW |
92 | |
93 | (pass-if "Lexical vars are collectable" | |
9c5d7fa6 AW |
94 | (let ((l (compile |
95 | '(begin | |
96 | (define guardian (make-guardian)) | |
97 | (let ((f (list 'foo))) | |
98 | (guardian f)) | |
5270a001 | 99 | ((@ (test-suite lib) clear-stale-stack-references)) |
9c5d7fa6 AW |
100 | (gc)(gc)(gc) |
101 | (guardian)) | |
102 | ;; Prevent the optimizer from propagating f. | |
103 | #:opts '(#:partial-eval? #f)))) | |
86fafc44 | 104 | (maybe-gc-flakiness (equal? l '(foo)))))) |