;;;; weaks.test --- tests guile's weaks -*- scheme -*- ;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; any later version. ;;;; ;;;; This program 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 General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with this software; see the file COPYING. If not, write to ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;;;; Boston, MA 02110-1301 USA ;;;; ;;;; As a special exception, the Free Software Foundation gives permission ;;;; for additional uses of the text contained in its release of GUILE. ;;;; ;;;; The exception is that, if you link the GUILE library with other files ;;;; to produce an executable, this does not by itself cause the ;;;; resulting executable to be covered by the GNU General Public License. ;;;; Your use of that executable is in no way restricted on account of ;;;; linking the GUILE library code into it. ;;;; ;;;; This exception does not however invalidate any other reasons why ;;;; the executable file might be covered by the GNU General Public License. ;;;; ;;;; This exception applies only to the code released by the ;;;; Free Software Foundation under the name GUILE. If you copy ;;;; code from other Free Software Foundation releases into a copy of ;;;; GUILE, as the General Public License permits, the exception does ;;;; not apply to the code that you add in this way. To avoid misleading ;;;; anyone as to the status of such modified files, you must delete ;;;; this exception notice from them. ;;;; ;;;; If you write modifications of your own for GUILE, it is your choice ;;;; whether to permit this exception to apply to your modifications. ;;;; If you do not wish that, delete this exception notice. ;;; {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 :) ;;; 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-hash-table" (pass-if "create" (make-weak-key-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg (make-weak-key-hash-table '(bad arg)))) (with-test-prefix "make-weak-value-hash-table" (pass-if "create" (make-weak-value-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg (make-weak-value-hash-table '(bad arg)))) (with-test-prefix "make-doubly-weak-hash-table" (pass-if "create" (make-doubly-weak-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg (make-doubly-weak-hash-table '(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 (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))))))) (let ((x (make-weak-key-hash-table 17)) (y (make-weak-value-hash-table 17)) (z (make-doubly-weak-hash-table 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)))))