Arrange so that stack-cleaning loops in GC tests are not optimized out.

* test-suite/tests/gc.test (stack-cleanup): New procedure.
  ("Unused modules are removed"): Use it.

* test-suite/tests/threads.test (stack-cleanup): Likewise.
  ("mutex with owner not retained (bug #27450)"): Use it.

diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index 9aa12be..57643e8 100644 (file)
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,5 +1,6 @@
 ;;;; gc.test --- test guile's garbage collection    -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009,
+;;;;   2011 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
@@ -46,6 +47,13 @@
 ;;; 
 ;;;
 
+(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"
@@ -65,9 +73,7 @@
       (for-each (lambda (x) (guard (make-module))) (iota total))
 
       ;; Avoid false references to the modules on the stack.
-      (let cleanup ((i 20))
-        (and (> i 0)
-             (begin (cleanup (1- i)) i)))
+      (stack-cleanup 20)
 
       (gc)
       (gc) ;; twice: have to kill the weak vectors.

diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index db002f2..85a7c38 100644 (file)
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -36,6 +36,13 @@
     (equal? '(a b c) '(a b c))
     a))
 
+(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))))
+
 (if (provided? 'threads)
     (begin
 
@@ -403,9 +410,7 @@
             (g (let ((m (make-mutex))) (lock-mutex m) m))
 
             ;; Avoid false references to M on the stack.
-            (let cleanup ((i 20))
-              (and (> i 0)
-                   (begin (cleanup (1- i)) i)))
+            (stack-cleanup 20)
 
             (gc) (gc)
             (let ((m (g)))