diff options
-rw-r--r-- | test-suite/tests/guardians.test | 50 |
1 files changed, 45 insertions, 5 deletions
diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test index e6a4203a2..756747fe6 100644 --- a/test-suite/tests/guardians.test +++ b/test-suite/tests/guardians.test @@ -19,8 +19,18 @@ ;;;; Boston, MA 02110-1301 USA ;;; These tests make some questionable assumptions. +;;; ;;; - They assume that a GC will find all dead objects, so they ;;; will become flaky if we have a generational GC. +;;; +;;; - More generally, when a weakly referenced object doesn't disappear as +;;; expected, it's hard to tell whether that's because of a guardian bug of +;;; because a reference to it is being held somewhere, e.g., one some part +;;; of the stack that hasn't been overwritten. Thus, most tests cannot +;;; fail, they can just throw `unresolved'. We try hard to clear +;;; references that may have been left on the stacks (see "clear refs left +;;; on the stack" lines). +;;; ;;; - They assume that objects won't be saved by the guardian until ;;; they explicitly invoke GC --- in other words, they assume that GC ;;; won't happen too often. @@ -74,6 +84,25 @@ (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)) + + ;; FIXME: The following test fails because the guardian for `g2-garbage' + ;; disappared from the weak-car guardian list of `g2-garbage' right before + ;; `g2-garbage' was finalized (in `finalize_guarded ()'). Sample session + ;; (compiled with `-DDEBUG_GUARDIANS'): + ;; + ;; guile> (define g (make-guardian)) + ;; guile> (let ((g2 (make-guardian))) + ;; (format #t "g2 = ~x~%" (object-address g2)) + ;; (g2 (string-copy "foo")) + ;; (g g2)) + ;; g2 = 81fde18 + ;; guile> (gc) + ;; finalizing guarded 0x827f6a0 (1 guardians) + ;; guardian for 0x827f6a0 vanished + ;; end of finalize (0x827f6a0) + ;; finalizing guarded 0x81fde18 (1 guardians) + ;; end of finalize (0x81fde18) + (pass-if "g2-garbage saved" (or (and (procedure? seen-g2) (equal? (seen-g2) (list (string-copy @@ -117,6 +146,7 @@ (let ((g (make-guardian))) (gc) (g (cons #f #f)) + (cons 'clear 'stack) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin @@ -130,6 +160,7 @@ (gc) (g (cons #f #f)) (g (cons #t #t)) + (cons 'clear 'stack) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin @@ -144,6 +175,7 @@ (let ((g (make-guardian))) (gc) (g (cons #f #f)) + (cons 'clear 'stack) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin @@ -177,7 +209,8 @@ (gc) (let ((p (cons #f #f))) (g p) - (vector-set! v 0 p)) + (vector-set! v 0 p) + (set! p #f)) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin @@ -192,7 +225,8 @@ (gc) (let ((p (cons #f #f))) (g p) - (vector-set! v 0 p)) + (vector-set! v 0 p) + (set! p #f)) ;; clear refs left on the stack (begin (gc) (if (not (equal? (g) (cons #f #f))) @@ -206,7 +240,11 @@ (pass-if "element of guarded weak vector gets collected" (let ((g (make-guardian)) - (v (weak-vector (cons #f #f)))) + (v (weak-vector #f))) + ;; Note: We don't pass `(cons #f #f)' as an argument to `weak-vector' + ;; otherwise references to it are likely to be left on the stack. + (vector-set! v 0 (cons #f #f)) + (g v) (gc) (if (equal? (vector-ref v 0) (cons #f #f)) @@ -250,7 +288,8 @@ (gc) (let ((p (cons #f #f))) (g p) - (g p)) + (g p) + (set! p #f)) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin @@ -265,7 +304,8 @@ (gc) (let ((p (cons #f #f))) (g p) - (h p)) + (h p) + (set! p #f)) ;; clear refs left on the stack (if (not (eq? (g) #f)) (throw 'unresolved) (begin |