diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-09-18 21:41:25 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-09-18 21:41:25 +0200 |
commit | 1e2b4920cac71e6750673a84642db97c404092a7 (patch) | |
tree | 7a4e04e53e68726b92a8ac699f9b90d744eacb95 /test-suite/tests | |
parent | 2b0b09fed4e446712dde60781ed09a6100e833f3 (diff) | |
download | guile-1e2b4920cac71e6750673a84642db97c404092a7.tar.gz |
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.
Diffstat (limited to 'test-suite/tests')
-rw-r--r-- | test-suite/tests/gc.test | 14 | ||||
-rw-r--r-- | test-suite/tests/threads.test | 11 |
2 files changed, 18 insertions, 7 deletions
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test index 9aa12be34..57643e825 100644 --- 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 db002f245..85a7c38ef 100644 --- 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))) |