Fixed `guardians.test' so that it does not use symbols.
authorLudovic Courtes <ludovic.courtes@laas.fr>
Sun, 25 Jun 2006 22:43:20 +0000 (22:43 +0000)
committerLudovic Courtès <ludo@gnu.org>
Wed, 10 Sep 2008 18:28:03 +0000 (20:28 +0200)
* 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

test-suite/tests/guardians.test

index 15f67e6..e6a4203 100644 (file)
 (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))
       (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"