test-suite/tests/gc.test

   1 ;;;; gc.test --- test guile's garbage collection    -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
   3 ;;;;
   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
   7 ;;;; version 3 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  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
  16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18 (use-modules (ice-9 documentation)
  19              (test-suite lib))
  20
  21
  22 ;;;
  23 ;;; miscellaneous
  24 ;;;
  25
  26
  27 (define (documented? object)
  28   (not (not (object-documentation object))))
  29
  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
  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)))
  58
  59
  60 (with-test-prefix "gc"
  61   (pass-if "Unused modules are removed"
  62            (let*
  63                ((dummy (gc))
  64                 (last-count (cdr (assoc
  65                                   "eval-closure" (gc-live-object-stats)))))
  66
  67              (for-each (lambda (x) (make-module)) (iota 1000))
  68
  69              ;; XXX: This hack aims to clean up the stack to make sure we
  70              ;; don't leave a reference to one of the modules we created.  It
  71              ;; proved to be useful on SPARC:
  72              ;; http://lists.gnu.org/archive/html/guile-devel/2008-02/msg00006.html .
  73              (let cleanup ((i 10))
  74                (and (> i 0)
  75                     (begin (cleanup (1- i)) i)))
  76
  77              (gc)
  78              (gc) ;; twice: have to kill the weak vectors.
  79              (= last-count (cdr (assoc "eval-closure" (gc-live-object-stats)))))
  80            ))