1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-28 22:10:29 +02:00

Merge remote-tracking branch 'origin/stable-2.0'

This commit is contained in:
Andy Wingo 2011-11-11 16:27:30 +01:00
commit 16371014d6
4 changed files with 62 additions and 15 deletions

View file

@ -1,6 +1,6 @@
;;;; bitvectors.test --- tests guile's bitvectors -*- scheme -*-
;;;;
;;;; Copyright 2010 Free Software Foundation, Inc.
;;;; Copyright 2010, 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
@ -55,5 +55,20 @@
(uniform-vector-set! bv 0 #t)
(pass-if (eqv? (uniform-vector-ref bv 0) #t)))))
(with-test-prefix "bit-set*!"
(pass-if "#t"
(let ((v (bitvector #t #t #f #f)))
(bit-set*! v #*1010 #t)
(equal? v #*1110)))
(pass-if "#f"
(let ((v (bitvector #t #t #f #f)))
(bit-set*! v #*1010 #f)
(equal? v #*0100)))
(pass-if "#t, shorter"
(let ((v (bitvector #t #t #f #f)))
(bit-set*! v #*101 #t)
(equal? v #*1110)))
(pass-if "#f, shorter"
(let ((v (bitvector #t #t #f #f)))
(bit-set*! v #*101 #f)
(equal? v #*0100))))

View file

@ -16,8 +16,10 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(use-modules (ice-9 documentation)
(test-suite lib))
(define-module (test-suite tests gc)
#:use-module (ice-9 documentation)
#:use-module (test-suite lib)
#:use-module ((system base compile) #:select (compile)))
;;;
@ -62,10 +64,8 @@
(add-hook! after-gc-hook thunk)
(gc)
(remove-hook! after-gc-hook thunk)
foo)))
foo))
(with-test-prefix "gc"
(pass-if "Unused modules are removed"
(let* ((guard (make-guardian))
(total 1000))
@ -76,12 +76,22 @@
(stack-cleanup 20)
(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.
(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))))
total)))
(pass-if "Lexical vars are collectable"
(procedure?
(compile
'(begin
(define guardian (make-guardian))
(let ((f (lambda () (display "test\n"))))
(guardian f))
(gc)(gc)(gc)
(guardian))))))