mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

Fixed `guardians.test' so that it does not use symbols.

Browse source 
* test-suite/tests/guardians.test: Use strings instead of symbols for
  `g3-garbage' et al.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-42
This commit is contained in:
Ludovic Courtes 2006-06-25 22:43:20 +00:00 • committed by Ludovic Courtès
parent 9778b58a19
commit e13f1cbdff
1 changed files with 15 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

20
test-suite/tests/guardians.test
View file

@ -41,11 +41,18 @@
(gc)
;;; Who guards the guardian?
;;; Note: We use strings rather than symbols because symbols are usually
;;; ``interned'', i.e., kept in a weakly-keyed hash table, thus making them
;;; inappropriate for the tests below. Furthermore, we use `string-copy' in
;;; order to make sure that no string is kept around in the interpreter
;;; unwillingly (e.g., in the source-property weak hash table).
(gc)
(define g2 (make-guardian))
(g2 (list 'g2-garbage))
(g2 (list (string-copy "g2-garbage")))
(define g3 (make-guardian))
(g3 (list 'g3-garbage))
(g3 (list (string-copy "g3-garbage")))
(g3 g2)
(pass-if "g2-garbage not collected yet" (equal? (g2) #f))
(pass-if "g3-garbage not collected yet" (equal? (g3) #f))
@ -59,15 +66,18 @@
(if saved
(begin
(cond
((equal? saved '(g3-garbage)) (set! seen-g3-garbage #t))
((equal? saved (list (string-copy "g3-garbage")))
(set! seen-g3-garbage #t))
((procedure? saved) (set! seen-g2 saved))
(else (pk saved) (set! seen-something-else #t)))
(else (pk 'junk saved) (set! seen-something-else #t)))
(loop)))))
(pass-if "g3-garbage saved" (or seen-g3-garbage (throw 'unresolved)))
(pass-if "g2-saved" (or (procedure? seen-g2) (throw 'unresolved)))
(pass-if "nothing else saved" (not seen-something-else))
(pass-if "g2-garbage saved" (or (and (procedure? seen-g2)
(equal? (seen-g2) '(g2-garbage)))
(equal? (seen-g2)
(list (string-copy
"g2-garbage"))))
(throw 'unresolved))))
(with-test-prefix "standard guardian functionality"