--- /dev/null
+;;;; weaks.test --- tests guile's weaks -*- scheme -*-
+;;;; Copyright (C) 1999, 2001, 2003, 2006 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; {Description}
+
+;;; This is a semi test suite for weaks; I say semi, because weaks
+;;; are pretty non-deterministic given the amount of information we
+;;; can infer from scheme.
+;;;
+;;; In particular, we can't always reliably test the more important
+;;; aspects of weaks (i.e., that an object is removed when it's dead)
+;;; because we have no way of knowing for certain that the object is
+;;; really dead. It tests it anyway, but the failures of any `death'
+;;; tests really shouldn't be surprising.
+;;;
+;;; Interpret failures in the dying functions here as a hint that you
+;;; should look at any changes you've made involving weaks
+;;; (everything else should always pass), but there are a host of
+;;; other reasons why they might not work as tested here, so if you
+;;; haven't done anything to weaks, don't sweat it :)
+
+(use-modules (test-suite lib)
+ (ice-9 weak-vector))
+
+;;; Creation functions
+
+
+(with-test-prefix
+ "weak-creation"
+ (with-test-prefix "make-weak-vector"
+ (pass-if "normal"
+ (make-weak-vector 10 #f)
+ #t)
+ (pass-if-exception "bad size"
+ exception:wrong-type-arg
+ (make-weak-vector 'foo)))
+
+ (with-test-prefix "list->weak-vector"
+ (pass-if "create"
+ (let* ((lst '(a b c d e f g))
+ (wv (list->weak-vector lst)))
+ (and (eq? (vector-ref wv 0) 'a)
+ (eq? (vector-ref wv 1) 'b)
+ (eq? (vector-ref wv 2) 'c)
+ (eq? (vector-ref wv 3) 'd)
+ (eq? (vector-ref wv 4) 'e)
+ (eq? (vector-ref wv 5) 'f)
+ (eq? (vector-ref wv 6) 'g))))
+ (pass-if-exception "bad-args"
+ exception:wrong-type-arg
+ (list->weak-vector 32)))
+
+ (with-test-prefix "make-weak-key-alist-vector"
+ (pass-if "create"
+ (make-weak-key-alist-vector 17)
+ #t)
+ (pass-if-exception "bad-args"
+ exception:wrong-type-arg
+ (make-weak-key-alist-vector '(bad arg))))
+ (with-test-prefix "make-weak-value-alist-vector"
+ (pass-if "create"
+ (make-weak-value-alist-vector 17)
+ #t)
+ (pass-if-exception "bad-args"
+ exception:wrong-type-arg
+ (make-weak-value-alist-vector '(bad arg))))
+
+ (with-test-prefix "make-doubly-weak-alist-vector"
+ (pass-if "create"
+ (make-doubly-weak-alist-vector 17)
+ #t)
+ (pass-if-exception "bad-args"
+ exception:wrong-type-arg
+ (make-doubly-weak-alist-vector '(bad arg)))))
+
+
+
+
+;; This should remove most of the non-dying problems associated with
+;; trying this inside a closure
+
+(define global-weak (make-weak-vector 10 #f))
+(begin
+ (vector-set! global-weak 0 "string")
+ (vector-set! global-weak 1 "beans")
+ (vector-set! global-weak 2 "to")
+ (vector-set! global-weak 3 "utah")
+ (vector-set! global-weak 4 "yum yum")
+ (gc))
+
+;;; Normal weak vectors
+(let ((x (make-weak-vector 10 #f))
+ (bar "bar"))
+ (with-test-prefix
+ "weak-vector"
+ (pass-if "lives"
+ (begin
+ (vector-set! x 0 bar)
+ (gc)
+ (and (vector-ref x 0) (eq? bar (vector-ref x 0)))))
+ (pass-if "dies"
+ (begin
+ (gc)
+ (or (and (not (vector-ref global-weak 0))
+ (not (vector-ref global-weak 1))
+ (not (vector-ref global-weak 2))
+ (not (vector-ref global-weak 3))
+ (not (vector-ref global-weak 4)))
+ (throw 'unresolved))))))
+
+ (let ((x (make-weak-key-alist-vector 17))
+ (y (make-weak-value-alist-vector 17))
+ (z (make-doubly-weak-alist-vector 17))
+ (test-key "foo")
+ (test-value "bar"))
+ (with-test-prefix
+ "weak-hash"
+ (pass-if "lives"
+ (begin
+ (hashq-set! x test-key test-value)
+ (hashq-set! y test-key test-value)
+ (hashq-set! z test-key test-value)
+ (gc)
+ (gc)
+ (and (hashq-ref x test-key)
+ (hashq-ref y test-key)
+ (hashq-ref z test-key)
+ #t)))
+ (pass-if "weak-key dies"
+ (begin
+ (hashq-set! x "this" "is")
+ (hashq-set! x "a" "test")
+ (hashq-set! x "of" "the")
+ (hashq-set! x "emergency" "weak")
+ (hashq-set! x "key" "hash system")
+ (gc)
+ (and
+ (or (not (hashq-ref x "this"))
+ (not (hashq-ref x "a"))
+ (not (hashq-ref x "of"))
+ (not (hashq-ref x "emergency"))
+ (not (hashq-ref x "key")))
+ (hashq-ref x test-key)
+ #t)))
+
+ (pass-if "weak-value dies"
+ (begin
+ (hashq-set! y "this" "is")
+ (hashq-set! y "a" "test")
+ (hashq-set! y "of" "the")
+ (hashq-set! y "emergency" "weak")
+ (hashq-set! y "value" "hash system")
+ (gc)
+ (and (or (not (hashq-ref y "this"))
+ (not (hashq-ref y "a"))
+ (not (hashq-ref y "of"))
+ (not (hashq-ref y "emergency"))
+ (not (hashq-ref y "value")))
+ (hashq-ref y test-key)
+ #t)))
+ (pass-if "doubly-weak dies"
+ (begin
+ (hashq-set! z "this" "is")
+ (hashq-set! z "a" "test")
+ (hashq-set! z "of" "the")
+ (hashq-set! z "emergency" "weak")
+ (hashq-set! z "all" "hash system")
+ (gc)
+ (and (or (not (hashq-ref z "this"))
+ (not (hashq-ref z "a"))
+ (not (hashq-ref z "of"))
+ (not (hashq-ref z "emergency"))
+ (not (hashq-ref z "all")))
+ (hashq-ref z test-key)
+ #t)))))
projects / lilypond.git / blobdiff