test-suite/tests/weaks.test

   1 ;;;; weaks.test --- tests guile's weaks     -*- scheme -*-
   2 ;;;; Copyright (C) 1999, 2001, 2003 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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 (ice-9 weak-vector))
  37
  38 ;;; Creation functions
  39
  40
  41 (with-test-prefix
  42  "weak-creation"
  43  (with-test-prefix "make-weak-vector"
  44   (pass-if "normal"
  45     (make-weak-vector 10 #f)
  46     #t)
  47   (pass-if-exception "bad size"
  48     exception:wrong-type-arg
  49     (make-weak-vector 'foo)))
  50
  51  (with-test-prefix "list->weak-vector"
  52                    (pass-if "create"
  53                             (let* ((lst '(a b c d e f g))
  54                                    (wv (list->weak-vector lst)))
  55                               (and (eq? (vector-ref wv 0) 'a)
  56                                    (eq? (vector-ref wv 1) 'b)
  57                                    (eq? (vector-ref wv 2) 'c)
  58                                    (eq? (vector-ref wv 3) 'd)
  59                                    (eq? (vector-ref wv 4) 'e)
  60                                    (eq? (vector-ref wv 5) 'f)
  61                                    (eq? (vector-ref wv 6) 'g))))
  62                    (pass-if-exception "bad-args"
  63                      exception:wrong-type-arg
  64                      (list->weak-vector 32)))
  65
  66  (with-test-prefix "make-weak-key-alist-vector"
  67                    (pass-if "create"
  68                      (make-weak-key-alist-vector 17)
  69                      #t)
  70                    (pass-if-exception "bad-args"
  71                      exception:wrong-type-arg
  72                      (make-weak-key-alist-vector '(bad arg))))
  73  (with-test-prefix "make-weak-value-alist-vector"
  74                    (pass-if "create"
  75                      (make-weak-value-alist-vector 17)
  76                      #t)
  77                    (pass-if-exception "bad-args"
  78                      exception:wrong-type-arg
  79                      (make-weak-value-alist-vector '(bad arg))))
  80
  81  (with-test-prefix "make-doubly-weak-alist-vector"
  82                    (pass-if "create"
  83                      (make-doubly-weak-alist-vector 17)
  84                      #t)
  85                    (pass-if-exception "bad-args"
  86                      exception:wrong-type-arg
  87                      (make-doubly-weak-alist-vector '(bad arg)))))
  88
  89
  90
  91
  92 ;; This should remove most of the non-dying problems associated with
  93 ;; trying this inside a closure
  94
  95 (define global-weak (make-weak-vector 10 #f))
  96 (begin
  97   (vector-set! global-weak 0 "string")
  98   (vector-set! global-weak 1 "beans")
  99   (vector-set! global-weak 2 "to")
 100   (vector-set! global-weak 3 "utah")
 101   (vector-set! global-weak 4 "yum yum")
 102   (gc))
 103
 104 ;;; Normal weak vectors
 105 (let ((x (make-weak-vector 10 #f))
 106       (bar "bar"))
 107   (with-test-prefix
 108    "weak-vector"
 109    (pass-if "lives"
 110             (begin
 111               (vector-set! x 0 bar)
 112               (gc)
 113               (and (vector-ref x 0) (eq? bar (vector-ref x 0)))))
 114    (pass-if "dies"
 115             (begin
 116               (gc)
 117               (or (not (vector-ref global-weak 0))
 118                   (not (vector-ref global-weak 1))
 119                   (not (vector-ref global-weak 2))
 120                   (not (vector-ref global-weak 3))
 121                   (not (vector-ref global-weak 4)))))))
 122
 123  (let ((x (make-weak-key-alist-vector 17))
 124       (y (make-weak-value-alist-vector 17))
 125       (z (make-doubly-weak-alist-vector 17))
 126       (test-key "foo")
 127       (test-value "bar"))
 128   (with-test-prefix
 129    "weak-hash"
 130    (pass-if "lives"
 131             (begin
 132               (hashq-set! x test-key test-value)
 133               (hashq-set! y test-key test-value)
 134               (hashq-set! z test-key test-value)
 135               (gc)
 136               (gc)
 137               (and (hashq-ref x test-key)
 138                    (hashq-ref y test-key)
 139                    (hashq-ref z test-key)
 140                    #t)))
 141    (pass-if "weak-key dies"
 142             (begin
 143               (hashq-set! x "this" "is")
 144               (hashq-set! x "a" "test")
 145               (hashq-set! x "of" "the")
 146               (hashq-set! x "emergency" "weak")
 147               (hashq-set! x "key" "hash system")
 148               (gc)
 149               (and
 150                (or (not (hashq-ref x "this"))
 151                    (not (hashq-ref x "a"))
 152                    (not (hashq-ref x "of"))
 153                    (not (hashq-ref x "emergency"))
 154                    (not (hashq-ref x "key")))
 155                (hashq-ref x test-key)
 156                #t)))
 157
 158    (pass-if "weak-value dies"
 159             (begin
 160               (hashq-set! y "this" "is")
 161               (hashq-set! y "a" "test")
 162               (hashq-set! y "of" "the")
 163               (hashq-set! y "emergency" "weak")
 164               (hashq-set! y "value" "hash system")
 165               (gc)
 166               (and (or (not (hashq-ref y "this"))
 167                        (not (hashq-ref y "a"))
 168                        (not (hashq-ref y "of"))
 169                        (not (hashq-ref y "emergency"))
 170                        (not (hashq-ref y "value")))
 171                    (hashq-ref y test-key)
 172                    #t)))
 173    (pass-if "doubly-weak dies"
 174             (begin
 175               (hashq-set! z "this" "is")
 176               (hashq-set! z "a" "test")
 177               (hashq-set! z "of" "the")
 178               (hashq-set! z "emergency" "weak")
 179               (hashq-set! z "all" "hash system")
 180               (gc)
 181               (and (or (not (hashq-ref z "this"))
 182                        (not (hashq-ref z "a"))
 183                        (not (hashq-ref z "of"))
 184                        (not (hashq-ref z "emergency"))
 185                        (not (hashq-ref z "all")))
 186                    (hashq-ref z test-key)
 187                    #t)))))