Calculate usecs correctly in thread-sleep!

[bpt/guile.git] / test-suite / tests / gc.test

diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index 527bef5..04f3539 100644 (file)
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,6 +1,6 @@
 ;;;; gc.test --- test guile's garbage collection    -*- scheme -*-
 ;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009,
-;;;;   2011, 2012 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -16,12 +16,22 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(define-module (test-suite tests gc)
+(define-module (tests gc)
   #:use-module (ice-9 documentation)
   #:use-module (test-suite lib)
   #:use-module ((system base compile) #:select (compile)))
 
 
+;; Some of these tests verify that things are collectable.  As we use a
+;; third-party conservative collector, we really can't guarantee that --
+;; we can try, but on some platforms, on some versions (possibly), the
+;; test might fail.  But we don't want that to stop the build.  So,
+;; instead of failing, throw 'unresolved.
+;;
+(define (maybe-gc-flakiness result)
+  (or result
+      (throw 'unresolved)))
+
 ;;;
 ;;; miscellaneous
 ;;;
@@ -49,13 +59,6 @@
 ;;; 
 ;;;
 
-(define (stack-cleanup depth)
-  ;; Clean up stack space for DEPTH words.  This is defined here so that
-  ;; `peval' doesn't inline it.
-  (let cleanup ((i depth))
-    (and (> i 0)
-         (begin (cleanup (1- i)) i))))
-
 (with-test-prefix "gc"
 
   (pass-if "after-gc-hook gets called"
@@ -73,28 +76,29 @@
       (for-each (lambda (x) (guard (make-module))) (iota total))
 
       ;; Avoid false references to the modules on the stack.
-      (stack-cleanup 20)
+      (clear-stale-stack-references)
 
       (gc)
       (gc)   ;; twice: have to kill the weak vectors.
       (gc)   ;; thrice: because the test doesn't succeed with only
       ;; one gc round. not sure why.
 
-      (= (let lp ((i 0))
-           (if (guard)
-               (lp (1+ i))
-               i))
-         total)))
+      (maybe-gc-flakiness
+       (= (let lp ((i 0))
+            (if (guard)
+                (lp (1+ i))
+                i))
+          total))))
 
   (pass-if "Lexical vars are collectable"
-    (list?
-     (compile
-      '(begin
-         (define guardian (make-guardian))
-         (let ((f (list 'foo)))
-           ;; Introduce a useless second reference to f to prevent the
-           ;; optimizer from propagating the lexical binding.
-           f
-           (guardian f))
-         (gc)(gc)(gc)
-         (guardian))))))
+    (let ((l (compile
+              '(begin
+                 (define guardian (make-guardian))
+                 (let ((f (list 'foo)))
+                   (guardian f))
+                 ((@ (test-suite lib) clear-stale-stack-references))
+                 (gc)(gc)(gc)
+                 (guardian))
+              ;; Prevent the optimizer from propagating f.
+              #:opts '(#:partial-eval? #f))))
+      (maybe-gc-flakiness (equal? l '(foo))))))