mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2011-09-18 21:41:25 +02:00
parent 2b0b09fed4
commit 1e2b4920ca
2 changed files with 18 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

14
test-suite/tests/gc.test
View file

@ -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.

11
test-suite/tests/threads.test
View file

@ -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)))