1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00

Strengthen the weak hash table tests.

* test-suite/tests/weaks.test: Enclose in a module.
  (valid?): New procedure.
  ("weak-hash")["weak-key dies, "weak-value dies", "double-weak dies"]:
  Check that all the values are `valid?', in addition to checking that
  at least one of them is #f.
This commit is contained in:
Ludovic Courtès 2010-09-23 12:14:32 +02:00
parent 5a99a574e4
commit b88a954c7a

View file

@ -33,8 +33,12 @@
;;; other reasons why they might not work as tested here, so if you ;;; other reasons why they might not work as tested here, so if you
;;; haven't done anything to weaks, don't sweat it :) ;;; haven't done anything to weaks, don't sweat it :)
(use-modules (test-suite lib) (define-module (test-weaks)
(ice-9 weak-vector)) #:use-module (test-suite lib)
#:use-module (ice-9 weak-vector)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26))
;;; Creation functions ;;; Creation functions
@ -122,6 +126,18 @@
(not (vector-ref global-weak 4))) (not (vector-ref global-weak 4)))
(throw 'unresolved)))))) (throw 'unresolved))))))
;;;
;;; Weak hash tables & weak alist vectors.
;;;
(define (valid? value initial-value)
;; Return true if VALUE is "valid", i.e., if it's either #f or
;; INITIAL-VALUE. The idea is to make sure `hash-ref' doesn't return
;; garbage.
(or (not value)
(equal? val initial-value)))
(let ((x (make-weak-key-alist-vector 17)) (let ((x (make-weak-key-alist-vector 17))
(y (make-weak-value-alist-vector 17)) (y (make-weak-value-alist-vector 17))
(z (make-doubly-weak-alist-vector 17)) (z (make-doubly-weak-alist-vector 17))
@ -152,14 +168,13 @@
(hash-set! x (string-copy "emergency") "weak") (hash-set! x (string-copy "emergency") "weak")
(hash-set! x (string-copy "key") "hash system") (hash-set! x (string-copy "key") "hash system")
(gc) (gc)
(and (let ((values (map (cut hash-ref x <>)
(or (not (hash-ref x "this")) '("this" "a" "of" "emergency" "key"))))
(not (hash-ref x "a")) (and (every valid? values
(not (hash-ref x "of")) '("is" "test" "the" "weak" "hash system"))
(not (hash-ref x "emergency")) (any not values)
(not (hash-ref x "key"))) (hash-ref x test-key)
(hash-ref x test-key) #t))))
#t)))
(pass-if "weak-value dies" (pass-if "weak-value dies"
(begin (begin
@ -169,13 +184,13 @@
(hash-set! y "emergency" (string-copy "weak")) (hash-set! y "emergency" (string-copy "weak"))
(hash-set! y "value" (string-copy "hash system")) (hash-set! y "value" (string-copy "hash system"))
(gc) (gc)
(and (or (not (hash-ref y "this")) (let ((values (map (cut hash-ref y <>)
(not (hash-ref y "a")) '("this" "a" "of" "emergency" "key"))))
(not (hash-ref y "of")) (and (every valid? values
(not (hash-ref y "emergency")) '("is" "test" "the" "weak" "hash system"))
(not (hash-ref y "value"))) (any not values)
(hash-ref y test-key) (hash-ref y test-key)
#t))) #t))))
(pass-if "doubly-weak dies" (pass-if "doubly-weak dies"
(begin (begin
@ -185,10 +200,10 @@
(hash-set! z "emergency" (string-copy "weak")) (hash-set! z "emergency" (string-copy "weak"))
(hash-set! z (string-copy "all") (string-copy "hash system")) (hash-set! z (string-copy "all") (string-copy "hash system"))
(gc) (gc)
(and (or (not (hash-ref z "this")) (let ((values (map (cut hash-ref z <>)
(not (hash-ref z "a")) '("this" "a" "of" "emergency" "key"))))
(not (hash-ref z "of")) (and (every valid? values
(not (hash-ref z "emergency")) '("is" "test" "the" "weak" "hash system"))
(not (hash-ref z "all"))) (any not values)
(hash-ref z test-key) (hash-ref z test-key)
#t))))) #t))))))