guile18/test-suite/tests/weaks.test

   1 ;;;; weaks.test --- tests guile's weaks     -*- scheme -*-
   2 ;;;; Copyright (C) 1999, 2001, 2003, 2006 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 2.1 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 ;;; {Description}
  19
  20 ;;; This is a semi test suite for weaks; I say semi, because weaks
  21 ;;; are pretty non-deterministic given the amount of information we
  22 ;;; can infer from scheme.
  23 ;;;
  24 ;;; In particular, we can't always reliably test the more important
  25 ;;; aspects of weaks (i.e., that an object is removed when it's dead)
  26 ;;; because we have no way of knowing for certain that the object is
  27 ;;; really dead. It tests it anyway, but the failures of any `death'
  28 ;;; tests really shouldn't be surprising.
  29 ;;;
  30 ;;; Interpret failures in the dying functions here as a hint that you
  31 ;;; should look at any changes you've made involving weaks
  32 ;;; (everything else should always pass), but there are a host of
  33 ;;; other reasons why they might not work as tested here, so if you
  34 ;;; haven't done anything to weaks, don't sweat it :)
  35
  36 (use-modules (test-suite lib)
  37              (ice-9 weak-vector))
  38
  39 ;;; Creation functions
  40
  41
  42 (with-test-prefix
  43  "weak-creation"
  44  (with-test-prefix "make-weak-vector"
  45   (pass-if "normal"
  46     (make-weak-vector 10 #f)
  47     #t)
  48   (pass-if-exception "bad size"
  49     exception:wrong-type-arg
  50     (make-weak-vector 'foo)))
  51
  52  (with-test-prefix "list->weak-vector"
  53                    (pass-if "create"
  54                             (let* ((lst '(a b c d e f g))
  55                                    (wv (list->weak-vector lst)))
  56                               (and (eq? (vector-ref wv 0) 'a)
  57                                    (eq? (vector-ref wv 1) 'b)
  58                                    (eq? (vector-ref wv 2) 'c)
  59                                    (eq? (vector-ref wv 3) 'd)
  60                                    (eq? (vector-ref wv 4) 'e)
  61                                    (eq? (vector-ref wv 5) 'f)
  62                                    (eq? (vector-ref wv 6) 'g))))
  63                    (pass-if-exception "bad-args"
  64                      exception:wrong-type-arg
  65                      (list->weak-vector 32)))
  66
  67  (with-test-prefix "make-weak-key-alist-vector"
  68                    (pass-if "create"
  69                      (make-weak-key-alist-vector 17)
  70                      #t)
  71                    (pass-if-exception "bad-args"
  72                      exception:wrong-type-arg
  73                      (make-weak-key-alist-vector '(bad arg))))
  74  (with-test-prefix "make-weak-value-alist-vector"
  75                    (pass-if "create"
  76                      (make-weak-value-alist-vector 17)
  77                      #t)
  78                    (pass-if-exception "bad-args"
  79                      exception:wrong-type-arg
  80                      (make-weak-value-alist-vector '(bad arg))))
  81
  82  (with-test-prefix "make-doubly-weak-alist-vector"
  83                    (pass-if "create"
  84                      (make-doubly-weak-alist-vector 17)
  85                      #t)
  86                    (pass-if-exception "bad-args"
  87                      exception:wrong-type-arg
  88                      (make-doubly-weak-alist-vector '(bad arg)))))
  89
  90
  91
  92
  93 ;; This should remove most of the non-dying problems associated with
  94 ;; trying this inside a closure
  95
  96 (define global-weak (make-weak-vector 10 #f))
  97 (begin
  98   (vector-set! global-weak 0 "string")
  99   (vector-set! global-weak 1 "beans")
 100   (vector-set! global-weak 2 "to")
 101   (vector-set! global-weak 3 "utah")
 102   (vector-set! global-weak 4 "yum yum")
 103   (gc))
 104
 105 ;;; Normal weak vectors
 106 (let ((x (make-weak-vector 10 #f))
 107       (bar "bar"))
 108   (with-test-prefix
 109    "weak-vector"
 110    (pass-if "lives"
 111             (begin
 112               (vector-set! x 0 bar)
 113               (gc)
 114               (and (vector-ref x 0) (eq? bar (vector-ref x 0)))))
 115    (pass-if "dies"
 116             (begin
 117               (gc)
 118               (or (and (not (vector-ref global-weak 0))
 119                        (not (vector-ref global-weak 1))
 120                        (not (vector-ref global-weak 2))
 121                        (not (vector-ref global-weak 3))
 122                        (not (vector-ref global-weak 4)))
 123                   (throw 'unresolved))))))
 124
 125  (let ((x (make-weak-key-alist-vector 17))
 126       (y (make-weak-value-alist-vector 17))
 127       (z (make-doubly-weak-alist-vector 17))
 128       (test-key "foo")
 129       (test-value "bar"))
 130   (with-test-prefix
 131    "weak-hash"
 132    (pass-if "lives"
 133             (begin
 134               (hashq-set! x test-key test-value)
 135               (hashq-set! y test-key test-value)
 136               (hashq-set! z test-key test-value)
 137               (gc)
 138               (gc)
 139               (and (hashq-ref x test-key)
 140                    (hashq-ref y test-key)
 141                    (hashq-ref z test-key)
 142                    #t)))
 143    (pass-if "weak-key dies"
 144             (begin
 145               (hashq-set! x "this" "is")
 146               (hashq-set! x "a" "test")
 147               (hashq-set! x "of" "the")
 148               (hashq-set! x "emergency" "weak")
 149               (hashq-set! x "key" "hash system")
 150               (gc)
 151               (and
 152                (or (not (hashq-ref x "this"))
 153                    (not (hashq-ref x "a"))
 154                    (not (hashq-ref x "of"))
 155                    (not (hashq-ref x "emergency"))
 156                    (not (hashq-ref x "key")))
 157                (hashq-ref x test-key)
 158                #t)))
 159
 160    (pass-if "weak-value dies"
 161             (begin
 162               (hashq-set! y "this" "is")
 163               (hashq-set! y "a" "test")
 164               (hashq-set! y "of" "the")
 165               (hashq-set! y "emergency" "weak")
 166               (hashq-set! y "value" "hash system")
 167               (gc)
 168               (and (or (not (hashq-ref y "this"))
 169                        (not (hashq-ref y "a"))
 170                        (not (hashq-ref y "of"))
 171                        (not (hashq-ref y "emergency"))
 172                        (not (hashq-ref y "value")))
 173                    (hashq-ref y test-key)
 174                    #t)))
 175    (pass-if "doubly-weak dies"
 176             (begin
 177               (hashq-set! z "this" "is")
 178               (hashq-set! z "a" "test")
 179               (hashq-set! z "of" "the")
 180               (hashq-set! z "emergency" "weak")
 181               (hashq-set! z "all" "hash system")
 182               (gc)
 183               (and (or (not (hashq-ref z "this"))
 184                        (not (hashq-ref z "a"))
 185                        (not (hashq-ref z "of"))
 186                        (not (hashq-ref z "emergency"))
 187                        (not (hashq-ref z "all")))
 188                    (hashq-ref z test-key)
 189                    #t)))))