mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 04:40:29 +02:00
Code Activity

Merge commit '2e77f7202b' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	libguile/threads.c
This commit is contained in:
Ludovic Courtès 2008-09-10 22:51:46 +02:00
commit e0513d4d77
20 changed files with 1120 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

6
test-suite/tests/reader.test
View file

@ -84,7 +84,11 @@
(pass-if "unprintable symbol"
;; The reader tolerates unprintable characters for symbols.
(equal? (string->symbol "\001\002\003")
(read-string "\001\002\003"))))
(read-string "\001\002\003")))
(pass-if "CR recognized as a token delimiter"
;; In 1.8.3, character 0x0d was not recognized as a delimiter.
(equal? (read-string "one\x0dtwo") 'one)))
(pass-if-exception "radix passed to number->string can't be zero"

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

@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
;;;; Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -17,8 +17,10 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (ice-9 threads)
(test-suite lib))
(define-module (test-threads)
:use-module (ice-9 threads)
:use-module (test-suite lib))
(if (provided? 'threads)
(begin
@ -133,4 +135,54 @@
(lambda (n) (set! result (cons n result)))
(lambda (n) (* 2 n))
'(0 1 2 3 4 5))
(equal? result '(10 8 6 4 2 0)))))))
(equal? result '(10 8 6 4 2 0)))))
;;
;; thread cancellation
;;
(with-test-prefix "cancel-thread"
(pass-if "cancel succeeds"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin (lock-mutex m) 'foo))))
(cancel-thread t)
(join-thread t)
#t)))
(pass-if "handler result passed to join"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (lock-mutex m))))
(set-thread-cleanup! t (lambda () 'foo))
(cancel-thread t)
(eq? (join-thread t) 'foo))))
(pass-if "can cancel self"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin
(set-thread-cleanup! (current-thread)
(lambda () 'foo))
(cancel-thread (current-thread))
(lock-mutex m)))))
(eq? (join-thread t) 'foo))))
(pass-if "handler supplants final expr"
(let ((t (begin-thread (begin (set-thread-cleanup! (current-thread)
(lambda () 'bar))
'foo))))
(eq? (join-thread t) 'bar)))
(pass-if "remove handler by setting false"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (lock-mutex m) 'bar)))
(set-thread-cleanup! t (lambda () 'foo))
(set-thread-cleanup! t #f)
(unlock-mutex m)
(eq? (join-thread t) 'bar))))
(pass-if "initial handler is false"
(not (thread-cleanup (current-thread)))))))