;;;; weaks.test --- tests guile's weaks -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010 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 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 3 of the License, or (at your option) any later version.
;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; 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 General Public License for more details.
+;;;; 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 General Public License
-;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 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.
+;;;; 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}
;;; 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 (ice-9 weak-vector))
+(use-modules (test-suite lib)
+ (ice-9 weak-vector))
;;; Creation functions
(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")
+ (vector-set! global-weak 0 (string-copy "string"))
+ (vector-set! global-weak 1 (string-copy "beans"))
+ (vector-set! global-weak 2 (string-copy "to"))
+ (vector-set! global-weak 3 (string-copy "utah"))
+ (vector-set! global-weak 4 (string-copy "yum yum"))
(gc))
;;; Normal weak vectors
(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)))))))
+ (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))
"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)
+ (hash-set! x test-key test-value)
+ (hash-set! y test-key test-value)
+ (hash-set! z test-key test-value)
(gc)
(gc)
- (and (hashq-ref x test-key)
- (hashq-ref y test-key)
- (hashq-ref z test-key)
+ (and (hash-ref x test-key)
+ (hash-ref y test-key)
+ (hash-ref z test-key)
#t)))
+
+ ;; In the tests below we use `string-copy' to avoid the risk of
+ ;; unintended retention of a string that we want to be GC'd.
+
(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)))
+ (begin
+ (hash-set! x (string-copy "this") "is")
+ (hash-set! x (string-copy "a") "test")
+ (hash-set! x (string-copy "of") "the")
+ (hash-set! x (string-copy "emergency") "weak")
+ (hash-set! x (string-copy "key") "hash system")
+ (gc)
+ (and
+ (or (not (hash-ref x "this"))
+ (not (hash-ref x "a"))
+ (not (hash-ref x "of"))
+ (not (hash-ref x "emergency"))
+ (not (hash-ref x "key")))
+ (hash-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)))
+ (begin
+ (hash-set! y "this" (string-copy "is"))
+ (hash-set! y "a" (string-copy "test"))
+ (hash-set! y "of" (string-copy "the"))
+ (hash-set! y "emergency" (string-copy "weak"))
+ (hash-set! y "value" (string-copy "hash system"))
+ (gc)
+ (and (or (not (hash-ref y "this"))
+ (not (hash-ref y "a"))
+ (not (hash-ref y "of"))
+ (not (hash-ref y "emergency"))
+ (not (hash-ref y "value")))
+ (hash-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)))))
+ (begin
+ (hash-set! z (string-copy "this") (string-copy "is"))
+ (hash-set! z "a" (string-copy "test"))
+ (hash-set! z (string-copy "of") "the")
+ (hash-set! z "emergency" (string-copy "weak"))
+ (hash-set! z (string-copy "all") (string-copy "hash system"))
+ (gc)
+ (and (or (not (hash-ref z "this"))
+ (not (hash-ref z "a"))
+ (not (hash-ref z "of"))
+ (not (hash-ref z "emergency"))
+ (not (hash-ref z "all")))
+ (hash-ref z test-key)
+ #t)))))
HCoop / bpt / guile.git / blobdiff