[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-61-ga850c3c

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a850c3ccc4bebe07dba2298c5ed0bc86bb64f172

The branch, stable-2.0 has been updated
       via  a850c3ccc4bebe07dba2298c5ed0bc86bb64f172 (commit)
       via  006163e02febaf5569bd42b362957a99c01c4528 (commit)
      from  a2e946f1ef83cd1fd8c87412cc49f6c6d1e0ac61 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit a850c3ccc4bebe07dba2298c5ed0bc86bb64f172
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 24 20:01:47 2012 +0100

    srfi-18 test fix
    
    * test-suite/tests/srfi-18.test: Enclose the tests in a begin instead of
      an and.  Before, they were not being run, for some reason I don't
      fully understand.

commit 006163e02febaf5569bd42b362957a99c01c4528
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 24 19:58:45 2012 +0100

    slight cleanup to run-test
    
    * test-suite/lib.scm (run-test): Slight cleanup.

-----------------------------------------------------------------------

Summary of changes:
 test-suite/lib.scm            |   55 ++--
 test-suite/tests/srfi-18.test |  863 ++++++++++++++++++++---------------------
 2 files changed, 457 insertions(+), 461 deletions(-)

diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 681a0d1..5785378 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -314,34 +314,33 @@
 
 ;;; The central testing routine.
 ;;; The idea is taken from Greg, the GNUstep regression test environment.
-(define run-test #f)
-(let ((test-running #f))
-  (define (local-run-test name expect-pass thunk)
-    (if test-running
-       (error "Nested calls to run-test are not permitted.")
-       (let ((test-name (full-name name)))
-         (set! test-running #t)
-         (catch #t
-           (lambda ()
-             (let ((result (thunk)))
-               (if (eq? result #t) (throw 'pass))
-               (if (eq? result #f) (throw 'fail))
-               (throw 'unresolved)))
-           (lambda (key . args)
-             (case key
-               ((pass)
-                (report (if expect-pass 'pass 'upass) test-name))
-               ((fail)
-                (report (if expect-pass 'fail 'xfail) test-name))
-               ((unresolved untested unsupported)
-                (report key test-name))
-               ((quit)
-                (report 'unresolved test-name)
-                (quit))
-               (else
-                (report 'error test-name (cons key args))))))
-         (set! test-running #f))))
-  (set! run-test local-run-test))
+(define run-test
+  (let ((test-running #f))
+    (lambda (name expect-pass thunk)
+      (if test-running
+          (error "Nested calls to run-test are not permitted."))
+      (let ((test-name (full-name name)))
+            (set! test-running #t)
+            (catch #t
+              (lambda ()
+                (let ((result (thunk)))
+                  (if (eq? result #t) (throw 'pass))
+                  (if (eq? result #f) (throw 'fail))
+                  (throw 'unresolved)))
+              (lambda (key . args)
+                (case key
+                  ((pass)
+                   (report (if expect-pass 'pass 'upass) test-name))
+                  ((fail)
+                   (report (if expect-pass 'fail 'xfail) test-name))
+                  ((unresolved untested unsupported)
+                   (report key test-name))
+                  ((quit)
+                   (report 'unresolved test-name)
+                   (quit))
+                  (else
+                   (report 'error test-name (cons key args))))))
+            (set! test-running #f)))))
 
 ;;; A short form for tests that are expected to pass, taken from Greg.
 (define-syntax pass-if
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test
index b769ce1..47f8f7f 100644
--- a/test-suite/tests/srfi-18.test
+++ b/test-suite/tests/srfi-18.test
@@ -1,7 +1,7 @@
 ;;;; srfi-18.test --- Test suite for Guile's SRFI-18 functions. -*- scheme -*-
 ;;;; Julian Graham, 2007-10-26
 ;;;;
-;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2007, 2008, 2012 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
@@ -25,461 +25,458 @@
 (if (provided? 'threads)
     (use-modules (srfi srfi-18)))
 
-(and
- (provided? 'threads)
+(cond
+ ((provided? 'threads)
+  (with-test-prefix "current-thread"
 
-(with-test-prefix "current-thread"
+    (pass-if "current-thread eq current-thread"
+      (eq? (current-thread) (current-thread))))
 
-  (pass-if "current-thread eq current-thread"
-    (eq? (current-thread) (current-thread))))
+  (with-test-prefix "thread?"
 
-(with-test-prefix "thread?"
+    (pass-if "current-thread is thread"
+      (thread? (current-thread)))
 
-  (pass-if "current-thread is thread"
-    (thread? (current-thread)))
+    (pass-if "foo not thread"
+      (not (thread? 'foo))))
 
-  (pass-if "foo not thread"
-    (not (thread? 'foo))))
+  (with-test-prefix "make-thread"
 
-(with-test-prefix "make-thread"
+    (pass-if "make-thread creates new thread"
+      (let* ((n (length (all-threads)))
+             (t (make-thread (lambda () 'foo) 'make-thread-1))
+             (r (> (length (all-threads)) n)))
+        (thread-terminate! t) r)))
 
-  (pass-if "make-thread creates new thread"
-    (let* ((n (length (all-threads)))
-          (t (make-thread (lambda () 'foo) 'make-thread-1))
-          (r (> (length (all-threads)) n)))
-      (thread-terminate! t) r)))
+  (with-test-prefix "thread-name"
 
-(with-test-prefix "thread-name"
+    (pass-if "make-thread with name binds name"
+      (let* ((t (make-thread (lambda () 'foo) 'thread-name-1))
+             (r (eq? (thread-name t) 'thread-name-1)))
+        (thread-terminate! t) r))
 
-  (pass-if "make-thread with name binds name"
-    (let* ((t (make-thread (lambda () 'foo) 'thread-name-1))
-          (r (eq? (thread-name t) 'thread-name-1)))
-      (thread-terminate! t) r))
+    (pass-if "make-thread without name does not bind name"
+      (let* ((t (make-thread (lambda () 'foo)))
+             (r (not (thread-name t))))
+        (thread-terminate! t) r)))
 
-  (pass-if "make-thread without name does not bind name"
-    (let* ((t (make-thread (lambda () 'foo)))
-          (r (not (thread-name t))))
-      (thread-terminate! t) r)))
+  (with-test-prefix "thread-specific"
 
-(with-test-prefix "thread-specific"
+    (pass-if "thread-specific is initially #f"
+      (let* ((t (make-thread (lambda () 'foo) 'thread-specific-1))
+             (r (not (thread-specific t))))
+        (thread-terminate! t) r))
 
-  (pass-if "thread-specific is initially #f"
-    (let* ((t (make-thread (lambda () 'foo) 'thread-specific-1))
-          (r (not (thread-specific t))))
-      (thread-terminate! t) r))
+    (pass-if "thread-specific-set! can set value"
+      (let ((t (make-thread (lambda () 'foo) 'thread-specific-2)))
+        (thread-specific-set! t "hello")
+        (let ((r (equal? (thread-specific t) "hello")))
+          (thread-terminate! t) r))))
 
-  (pass-if "thread-specific-set! can set value"
-    (let ((t (make-thread (lambda () 'foo) 'thread-specific-2)))
-      (thread-specific-set! t "hello")
-      (let ((r (equal? (thread-specific t) "hello")))
-       (thread-terminate! t) r))))
+  (with-test-prefix "thread-start!"
 
-(with-test-prefix "thread-start!"
+    (pass-if "thread activates only after start" 
+      (let* ((started #f)
+             (m (make-mutex 'thread-start-mutex))
+             (t (make-thread (lambda () (set! started #t)) 'thread-start-1)))
+        (and (not started) (thread-start! t) (thread-join! t) started))))
 
-  (pass-if "thread activates only after start" 
-    (let* ((started #f)
-          (m (make-mutex 'thread-start-mutex))
-          (t (make-thread (lambda () (set! started #t)) 'thread-start-1)))
-      (and (not started) (thread-start! t) (thread-join! t) started))))
+  (with-test-prefix "thread-yield!"
 
-(with-test-prefix "thread-yield!"
+    (pass-if "thread yield suceeds"
+      (thread-yield!) #t))
 
-  (pass-if "thread yield suceeds"
-    (thread-yield!) #t))
+  (with-test-prefix "thread-sleep!"
 
-(with-test-prefix "thread-sleep!"
+    (pass-if "thread sleep with time"
+      (let ((future-time (seconds->time (+ (time->seconds (current-time)) 2))))
+        (unspecified? (thread-sleep! future-time))))
 
-  (pass-if "thread sleep with time"
-    (let ((future-time (seconds->time (+ (time->seconds (current-time)) 2))))
-      (unspecified? (thread-sleep! future-time))))
+    (pass-if "thread sleep with number"
+      (let ((old-secs (car (current-time))))
+        (unspecified? (thread-sleep! (+ (time->seconds (current-time)))))))
 
-  (pass-if "thread sleep with number"
-    (let ((old-secs (car (current-time))))
-      (unspecified? (thread-sleep! (+ (time->seconds (current-time)))))))
+    (pass-if "thread does not sleep on past time"
+      (let ((past-time (seconds->time (- (time->seconds (current-time)) 2))))
+        (unspecified? (thread-sleep! past-time)))))
 
-  (pass-if "thread does not sleep on past time"
-    (let ((past-time (seconds->time (- (time->seconds (current-time)) 2))))
-      (unspecified? (thread-sleep! past-time)))))
-
-(with-test-prefix "thread-terminate!"
+  (with-test-prefix "thread-terminate!"
   
-  (pass-if "termination destroys non-started thread"
-    (let ((t (make-thread (lambda () 'nothing) 'thread-terminate-1))
-         (num-threads (length (all-threads)))
-         (success #f))
-      (thread-terminate! t)
-      (with-exception-handler 
-       (lambda (obj) (set! success (terminated-thread-exception? obj)))
-       (lambda () (thread-join! t)))
-      success))
-
-  (pass-if "termination destroys started thread"
-    (let* ((m1 (make-mutex 'thread-terminate-2a))
-          (m2 (make-mutex 'thread-terminate-2b))
-          (c (make-condition-variable 'thread-terminate-2))
-          (t (make-thread (lambda () 
-                            (mutex-lock! m1) 
-                            (condition-variable-signal! c)
-                            (mutex-unlock! m1)
-                            (mutex-lock! m2))
-                          'thread-terminate-2))
-          (success #f))
-      (mutex-lock! m1)
-      (mutex-lock! m2)
-      (thread-start! t)
-      (mutex-unlock! m1 c)
-      (thread-terminate! t)
-      (with-exception-handler
-       (lambda (obj) (set! success (terminated-thread-exception? obj)))
-       (lambda () (thread-join! t)))
-      success)))
-
-(with-test-prefix "thread-join!"
-
-  (pass-if "join receives result of thread"
-    (let ((t (make-thread (lambda () 'foo) 'thread-join-1)))
-      (thread-start! t)
-      (eq? (thread-join! t) 'foo)))
-
-  (pass-if "join receives timeout val if timeout expires"
-    (let* ((m (make-mutex 'thread-join-2))
-          (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-2)))
-      (mutex-lock! m)
-      (thread-start! t)
-      (let ((r (thread-join! t (current-time) 'bar)))
-       (thread-terminate! t)
-       (eq? r 'bar))))
-
-  (pass-if "join throws exception on timeout without timeout val"
-    (let* ((m (make-mutex 'thread-join-3))
-          (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-3))
-          (success #f))
-      (mutex-lock! m)
-      (thread-start! t)
-      (with-exception-handler
-       (lambda (obj) (set! success (join-timeout-exception? obj)))
-       (lambda () (thread-join! t (current-time))))
-      (thread-terminate! t)
-      success))
-
-  (pass-if "join waits on timeout"
-    (let ((t (make-thread (lambda () (sleep 1) 'foo) 'thread-join-4)))
-      (thread-start! t)
-      (eq? (thread-join! t (+ (time->seconds (current-time)) 2)) 'foo))))
-
-(with-test-prefix "mutex?"
-
-  (pass-if "make-mutex creates mutex"
-    (mutex? (make-mutex)))
-
-  (pass-if "symbol not mutex"
-    (not (mutex? 'foo))))
-
-(with-test-prefix "mutex-name"
-
-  (pass-if "make-mutex with name binds name"
-    (let* ((m (make-mutex 'mutex-name-1)))
-      (eq? (mutex-name m) 'mutex-name-1)))
-
-  (pass-if "make-mutex without name does not bind name"
-    (let* ((m (make-mutex)))
-      (not (mutex-name m)))))
-
-(with-test-prefix "mutex-specific"
-
-  (pass-if "mutex-specific is initially #f"
-    (let ((m (make-mutex 'mutex-specific-1)))
-      (not (mutex-specific m))))
-
-  (pass-if "mutex-specific-set! can set value"
-    (let ((m (make-mutex 'mutex-specific-2)))
-      (mutex-specific-set! m "hello")
-      (equal? (mutex-specific m) "hello"))))
-
-(with-test-prefix "mutex-state"
-
-  (pass-if "mutex state is initially not-abandoned"
-    (let ((m (make-mutex 'mutex-state-1)))
-      (eq? (mutex-state m) 'not-abandoned)))
-
-  (pass-if "mutex state of locked, owned mutex is owner thread"
-    (let ((m (make-mutex 'mutex-state-2)))
-      (mutex-lock! m)
-      (eq? (mutex-state m) (current-thread))))
+    (pass-if "termination destroys non-started thread"
+      (let ((t (make-thread (lambda () 'nothing) 'thread-terminate-1))
+            (num-threads (length (all-threads)))
+            (success #f))
+        (thread-terminate! t)
+        (with-exception-handler 
+         (lambda (obj) (set! success (terminated-thread-exception? obj)))
+         (lambda () (thread-join! t)))
+        success))
+
+    (pass-if "termination destroys started thread"
+      (let* ((m1 (make-mutex 'thread-terminate-2a))
+             (m2 (make-mutex 'thread-terminate-2b))
+             (c (make-condition-variable 'thread-terminate-2))
+             (t (make-thread (lambda () 
+                               (mutex-lock! m1) 
+                               (condition-variable-signal! c)
+                               (mutex-unlock! m1)
+                               (mutex-lock! m2))
+                             'thread-terminate-2))
+             (success #f))
+        (mutex-lock! m1)
+        (mutex-lock! m2)
+        (thread-start! t)
+        (mutex-unlock! m1 c)
+        (thread-terminate! t)
+        (with-exception-handler
+         (lambda (obj) (set! success (terminated-thread-exception? obj)))
+         (lambda () (thread-join! t)))
+        success)))
+
+  (with-test-prefix "thread-join!"
+
+    (pass-if "join receives result of thread"
+      (let ((t (make-thread (lambda () 'foo) 'thread-join-1)))
+        (thread-start! t)
+        (eq? (thread-join! t) 'foo)))
+
+    (pass-if "join receives timeout val if timeout expires"
+      (let* ((m (make-mutex 'thread-join-2))
+             (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-2)))
+        (mutex-lock! m)
+        (thread-start! t)
+        (let ((r (thread-join! t (current-time) 'bar)))
+          (thread-terminate! t)
+          (eq? r 'bar))))
+
+    (pass-if "join throws exception on timeout without timeout val"
+      (let* ((m (make-mutex 'thread-join-3))
+             (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-3))
+             (success #f))
+        (mutex-lock! m)
+        (thread-start! t)
+        (with-exception-handler
+         (lambda (obj) (set! success (join-timeout-exception? obj)))
+         (lambda () (thread-join! t (current-time))))
+        (thread-terminate! t)
+        success))
+
+    (pass-if "join waits on timeout"
+      (let ((t (make-thread (lambda () (sleep 1) 'foo) 'thread-join-4)))
+        (thread-start! t)
+        (eq? (thread-join! t (+ (time->seconds (current-time)) 2)) 'foo))))
+
+  (with-test-prefix "mutex?"
+
+    (pass-if "make-mutex creates mutex"
+      (mutex? (make-mutex)))
+
+    (pass-if "symbol not mutex"
+      (not (mutex? 'foo))))
+
+  (with-test-prefix "mutex-name"
+
+    (pass-if "make-mutex with name binds name"
+      (let* ((m (make-mutex 'mutex-name-1)))
+        (eq? (mutex-name m) 'mutex-name-1)))
+
+    (pass-if "make-mutex without name does not bind name"
+      (let* ((m (make-mutex)))
+        (not (mutex-name m)))))
+
+  (with-test-prefix "mutex-specific"
+
+    (pass-if "mutex-specific is initially #f"
+      (let ((m (make-mutex 'mutex-specific-1)))
+        (not (mutex-specific m))))
+
+    (pass-if "mutex-specific-set! can set value"
+      (let ((m (make-mutex 'mutex-specific-2)))
+        (mutex-specific-set! m "hello")
+        (equal? (mutex-specific m) "hello"))))
+
+  (with-test-prefix "mutex-state"
+
+    (pass-if "mutex state is initially not-abandoned"
+      (let ((m (make-mutex 'mutex-state-1)))
+        (eq? (mutex-state m) 'not-abandoned)))
+
+    (pass-if "mutex state of locked, owned mutex is owner thread"
+      (let ((m (make-mutex 'mutex-state-2)))
+        (mutex-lock! m)
+        (eq? (mutex-state m) (current-thread))))
          
-  (pass-if "mutex state of locked, unowned mutex is not-owned"
-    (let ((m (make-mutex 'mutex-state-3)))
-      (mutex-lock! m #f #f)
-      (eq? (mutex-state m) 'not-owned)))
-
-  (pass-if "mutex state of unlocked, abandoned mutex is abandoned"
-    (let* ((m (make-mutex 'mutex-state-4))
-          (t (make-thread (lambda () (mutex-lock! m)))))
-      (thread-start! t)
-      (thread-join! t)
-      (eq? (mutex-state m) 'abandoned))))
-
-(with-test-prefix "mutex-lock!"
+    (pass-if "mutex state of locked, unowned mutex is not-owned"
+      (let ((m (make-mutex 'mutex-state-3)))
+        (mutex-lock! m #f #f)
+        (eq? (mutex-state m) 'not-owned)))
+
+    (pass-if "mutex state of unlocked, abandoned mutex is abandoned"
+      (let* ((m (make-mutex 'mutex-state-4))
+             (t (make-thread (lambda () (mutex-lock! m)))))
+        (thread-start! t)
+        (thread-join! t)
+        (eq? (mutex-state m) 'abandoned))))
+
+  (with-test-prefix "mutex-lock!"
   
-  (pass-if "mutex-lock! returns true on successful lock"
-    (let* ((m (make-mutex 'mutex-lock-1)))
-      (mutex-lock! m)))
-
-  (pass-if "mutex-lock! returns false on timeout"
-    (let* ((m (make-mutex 'mutex-lock-2))
-          (t (make-thread (lambda () (mutex-lock! m (current-time) #f)))))
-      (mutex-lock! m)
-      (thread-start! t)
-      (not (thread-join! t))))
-
-  (pass-if "mutex-lock! returns true when lock obtained within timeout"
-    (let* ((m (make-mutex 'mutex-lock-3))
-          (t (make-thread (lambda () 
-                            (mutex-lock! m (+ (time->seconds (current-time)) 
-                                              100)
-                                         #f)))))
-      (mutex-lock! m)
-      (thread-start! t)
-      (mutex-unlock! m)
-      (thread-join! t)))
-
-  (pass-if "can lock mutex for non-current thread"
-    (let* ((m1 (make-mutex 'mutex-lock-4a))
-          (m2 (make-mutex 'mutex-lock-4b))
-          (t (make-thread (lambda () (mutex-lock! m1)) 'mutex-lock-4)))
-      (mutex-lock! m1)
-      (thread-start! t)
-      (mutex-lock! m2 #f t)
-      (let ((success (eq? (mutex-state m2) t))) 
-       (thread-terminate! t) success)))
-
-  (pass-if "locking abandoned mutex throws exception"
-    (let* ((m (make-mutex 'mutex-lock-5))
-          (t (make-thread (lambda () (mutex-lock! m)) 'mutex-lock-5))
-          (success #f))
-      (thread-start! t)
-      (thread-join! t)
-      (with-exception-handler
-       (lambda (obj) (set! success (abandoned-mutex-exception? obj)))
-       (lambda () (mutex-lock! m)))
-      (and success (eq? (mutex-state m) (current-thread)))))
-
-  (pass-if "sleeping threads notified of abandonment"
-    (let* ((m1 (make-mutex 'mutex-lock-6a))
-          (m2 (make-mutex 'mutex-lock-6b))
-          (c (make-condition-variable 'mutex-lock-6))
-          (t (make-thread (lambda () 
-                            (mutex-lock! m1)
-                            (mutex-lock! m2)
-                            (condition-variable-signal! c))))
-          (success #f))
-      (mutex-lock! m1)
-      (thread-start! t)
-      (with-exception-handler
-       (lambda (obj) (set! success (abandoned-mutex-exception? obj)))
-       (lambda () (mutex-unlock! m1 c) (mutex-lock! m2)))
-      success)))
-
-(with-test-prefix "mutex-unlock!"
+    (pass-if "mutex-lock! returns true on successful lock"
+      (let* ((m (make-mutex 'mutex-lock-1)))
+        (mutex-lock! m)))
+
+    (pass-if "mutex-lock! returns false on timeout"
+      (let* ((m (make-mutex 'mutex-lock-2))
+             (t (make-thread (lambda () (mutex-lock! m (current-time) #f)))))
+        (mutex-lock! m)
+        (thread-start! t)
+        (not (thread-join! t))))
+
+    (pass-if "mutex-lock! returns true when lock obtained within timeout"
+      (let* ((m (make-mutex 'mutex-lock-3))
+             (t (make-thread (lambda () 
+                               (mutex-lock! m (+ (time->seconds 
(current-time)) 
+                                                 100)
+                                            #f)))))
+        (mutex-lock! m)
+        (thread-start! t)
+        (mutex-unlock! m)
+        (thread-join! t)))
+
+    (pass-if "can lock mutex for non-current thread"
+      (let* ((m1 (make-mutex 'mutex-lock-4a))
+             (m2 (make-mutex 'mutex-lock-4b))
+             (t (make-thread (lambda () (mutex-lock! m1)) 'mutex-lock-4)))
+        (mutex-lock! m1)
+        (thread-start! t)
+        (mutex-lock! m2 #f t)
+        (let ((success (eq? (mutex-state m2) t))) 
+          (thread-terminate! t) success)))
+
+    (pass-if "locking abandoned mutex throws exception"
+      (let* ((m (make-mutex 'mutex-lock-5))
+             (t (make-thread (lambda () (mutex-lock! m)) 'mutex-lock-5))
+             (success #f))
+        (thread-start! t)
+        (thread-join! t)
+        (with-exception-handler
+         (lambda (obj) (set! success (abandoned-mutex-exception? obj)))
+         (lambda () (mutex-lock! m)))
+        (and success (eq? (mutex-state m) (current-thread)))))
+
+    (pass-if "sleeping threads notified of abandonment"
+      (let* ((m1 (make-mutex 'mutex-lock-6a))
+             (m2 (make-mutex 'mutex-lock-6b))
+             (c (make-condition-variable 'mutex-lock-6))
+             (t (make-thread (lambda () 
+                               (mutex-lock! m1)
+                               (mutex-lock! m2)
+                               (condition-variable-signal! c))))
+             (success #f))
+        (mutex-lock! m1)
+        (thread-start! t)
+        (with-exception-handler
+         (lambda (obj) (set! success (abandoned-mutex-exception? obj)))
+         (lambda () (mutex-unlock! m1 c) (mutex-lock! m2)))
+        success)))
+
+  (with-test-prefix "mutex-unlock!"
    
-  (pass-if "unlock changes mutex state"
-    (let* ((m (make-mutex 'mutex-unlock-1)))
-      (mutex-lock! m)
-      (mutex-unlock! m)
-      (eq? (mutex-state m) 'not-abandoned)))
-
-  (pass-if "can unlock from any thread"
-    (let* ((m (make-mutex 'mutex-unlock-2))
-          (t (make-thread (lambda () (mutex-unlock! m)) 'mutex-unlock-2)))
-      (mutex-lock! m)
-      (thread-start! t)
-      (thread-join! t)
-      (eq? (mutex-state m) 'not-abandoned)))
-
-  (pass-if "mutex unlock is true when condition is signalled"
-    (let* ((m (make-mutex 'mutex-unlock-3))
-          (c (make-condition-variable 'mutex-unlock-3))
-          (t (make-thread (lambda () 
-                            (mutex-lock! m) 
-                            (condition-variable-signal! c) 
-                            (mutex-unlock! m)))))
-      (mutex-lock! m)
-      (thread-start! t)
-      (mutex-unlock! m c)))
-
-  (pass-if "mutex unlock is false when condition times out"
-    (let* ((m (make-mutex 'mutex-unlock-4))
-          (c (make-condition-variable 'mutex-unlock-4)))
-      (mutex-lock! m)
-      (not (mutex-unlock! m c (+ (time->seconds (current-time)) 1))))))
-
-(with-test-prefix "condition-variable?"
-
-  (pass-if "make-condition-variable creates condition variable"
-    (condition-variable? (make-condition-variable)))
-
-  (pass-if "symbol not condition variable"
-    (not (condition-variable? 'foo))))
-
-(with-test-prefix "condition-variable-name"
-
-  (pass-if "make-condition-variable with name binds name"
-    (let* ((c (make-condition-variable 'condition-variable-name-1)))
-      (eq? (condition-variable-name c) 'condition-variable-name-1)))
-
-  (pass-if "make-condition-variable without name does not bind name"
-    (let* ((c (make-condition-variable)))
-      (not (condition-variable-name c)))))
-
-(with-test-prefix "condition-variable-specific"
-
-  (pass-if "condition-variable-specific is initially #f"
-    (let ((c (make-condition-variable 'condition-variable-specific-1)))
-      (not (condition-variable-specific c))))
-
-  (pass-if "condition-variable-specific-set! can set value"
-    (let ((c (make-condition-variable 'condition-variable-specific-1)))
-      (condition-variable-specific-set! c "hello")
-      (equal? (condition-variable-specific c) "hello"))))
-
-(with-test-prefix "condition-variable-signal!"
+    (pass-if "unlock changes mutex state"
+      (let* ((m (make-mutex 'mutex-unlock-1)))
+        (mutex-lock! m)
+        (mutex-unlock! m)
+        (eq? (mutex-state m) 'not-abandoned)))
+
+    (pass-if "can unlock from any thread"
+      (let* ((m (make-mutex 'mutex-unlock-2))
+             (t (make-thread (lambda () (mutex-unlock! m)) 'mutex-unlock-2)))
+        (mutex-lock! m)
+        (thread-start! t)
+        (thread-join! t)
+        (eq? (mutex-state m) 'not-abandoned)))
+
+    (pass-if "mutex unlock is true when condition is signalled"
+      (let* ((m (make-mutex 'mutex-unlock-3))
+             (c (make-condition-variable 'mutex-unlock-3))
+             (t (make-thread (lambda () 
+                               (mutex-lock! m) 
+                               (condition-variable-signal! c) 
+                               (mutex-unlock! m)))))
+        (mutex-lock! m)
+        (thread-start! t)
+        (mutex-unlock! m c)))
+
+    (pass-if "mutex unlock is false when condition times out"
+      (let* ((m (make-mutex 'mutex-unlock-4))
+             (c (make-condition-variable 'mutex-unlock-4)))
+        (mutex-lock! m)
+        (not (mutex-unlock! m c (+ (time->seconds (current-time)) 1))))))
+
+  (with-test-prefix "condition-variable?"
+
+    (pass-if "make-condition-variable creates condition variable"
+      (condition-variable? (make-condition-variable)))
+
+    (pass-if "symbol not condition variable"
+      (not (condition-variable? 'foo))))
+
+  (with-test-prefix "condition-variable-name"
+
+    (pass-if "make-condition-variable with name binds name"
+      (let* ((c (make-condition-variable 'condition-variable-name-1)))
+        (eq? (condition-variable-name c) 'condition-variable-name-1)))
+
+    (pass-if "make-condition-variable without name does not bind name"
+      (let* ((c (make-condition-variable)))
+        (not (condition-variable-name c)))))
+
+  (with-test-prefix "condition-variable-specific"
+
+    (pass-if "condition-variable-specific is initially #f"
+      (let ((c (make-condition-variable 'condition-variable-specific-1)))
+        (not (condition-variable-specific c))))
+
+    (pass-if "condition-variable-specific-set! can set value"
+      (let ((c (make-condition-variable 'condition-variable-specific-1)))
+        (condition-variable-specific-set! c "hello")
+        (equal? (condition-variable-specific c) "hello"))))
+
+  (with-test-prefix "condition-variable-signal!"
   
-  (pass-if "condition-variable-signal! wakes up single thread"
-    (let* ((m (make-mutex 'condition-variable-signal-1))
-          (c (make-condition-variable 'condition-variable-signal-1))
-          (t (make-thread (lambda () 
-                            (mutex-lock! m) 
-                            (condition-variable-signal! c) 
-                            (mutex-unlock! m)))))
-      (mutex-lock! m)
-      (thread-start! t)
-      (mutex-unlock! m c))))
-
-(with-test-prefix "condition-variable-broadcast!"
-
-  (pass-if "condition-variable-broadcast! wakes up multiple threads"
-    (let* ((sem 0)
-          (c1 (make-condition-variable 'condition-variable-broadcast-1-a))
-          (m1 (make-mutex 'condition-variable-broadcast-1-a))
-          (c2 (make-condition-variable 'condition-variable-broadcast-1-b))
-          (m2 (make-mutex 'condition-variable-broadcast-1-b))
-          (inc-sem! (lambda () 
-                      (mutex-lock! m1)
-                      (set! sem (+ sem 1))
-                      (condition-variable-broadcast! c1)
-                      (mutex-unlock! m1)))
-          (dec-sem! (lambda ()
-                      (mutex-lock! m1)
-                      (while (eqv? sem 0) (wait-condition-variable c1 m1))
-                      (set! sem (- sem 1))
-                      (mutex-unlock! m1)))
-          (t1 (make-thread (lambda () 
-                             (mutex-lock! m2)
-                             (inc-sem!)
-                             (mutex-unlock! m2 c2)
-                             (inc-sem!))))
-          (t2 (make-thread (lambda () 
-                             (mutex-lock! m2)
-                             (inc-sem!)
-                             (mutex-unlock! m2 c2)
-                             (inc-sem!)))))
-      (thread-start! t1)
-      (thread-start! t2)
-      (dec-sem!)
-      (dec-sem!)
-      (mutex-lock! m2)
-      (condition-variable-broadcast! c2)
-      (mutex-unlock! m2)
-      (dec-sem!)
-      (dec-sem!))))
-
-(with-test-prefix "time?"
-
-  (pass-if "current-time is time" (time? (current-time)))
-  (pass-if "number is not time" (not (time? 123)))
-  (pass-if "symbol not time" (not (time? 'foo))))
-
-(with-test-prefix "time->seconds"
-
-  (pass-if "time->seconds makes time into rational"
-    (rational? (time->seconds (current-time))))
-
-  (pass-if "time->seconds is reversible"
-    (let ((t (current-time)))
-      (equal? t (seconds->time (time->seconds t))))))
-
-(with-test-prefix "seconds->time"
-
-  (pass-if "seconds->time makes rational into time"
-    (time? (seconds->time 123.456)))
-
-  (pass-if "seconds->time is reversible"
-    (let ((t (time->seconds (current-time))))
-      (equal? t (time->seconds (seconds->time t))))))
-
-(with-test-prefix "current-exception-handler"
-
-  (pass-if "current handler returned at top level"
-    (procedure? (current-exception-handler)))
-
-  (pass-if "specified handler set under with-exception-handler"
-    (let ((h (lambda (key . args) 'nothing)))
-      (with-exception-handler h (lambda () (eq? (current-exception-handler) 
-                                               h)))))
-
-  (pass-if "multiple levels of handler nesting"
-    (let ((h (lambda (key . args) 'nothing))
-         (i (current-exception-handler)))
-      (and (with-exception-handler h (lambda () 
-                                      (eq? (current-exception-handler) h)))
-          (eq? (current-exception-handler) i))))
-
-  (pass-if "exception handler installation is thread-safe"
-    (let* ((h1 (current-exception-handler))
-          (h2 (lambda (key . args) 'nothing-2))
-          (m (make-mutex 'current-exception-handler-4))
-          (c (make-condition-variable 'current-exception-handler-4))
-          (t (make-thread (lambda () 
-                            (with-exception-handler 
-                             h2 (lambda () 
-                                  (mutex-lock! m) 
-                                  (condition-variable-signal! c) 
-                                  (wait-condition-variable c m)
-                                  (and (eq? (current-exception-handler) h2)
-                                       (mutex-unlock! m)))))
-                          'current-exception-handler-4)))
-      (mutex-lock! m)
-      (thread-start! t)
-      (wait-condition-variable c m)
-      (and (eq? (current-exception-handler) h1)
-          (condition-variable-signal! c)
-          (mutex-unlock! m)
-          (thread-join! t)))))
-
-(with-test-prefix "uncaught-exception-reason"
-
-  (pass-if "initial handler captures top level exception"
-    (let ((t (make-thread (lambda () (raise 'foo))))
-         (success #f))
-      (thread-start! t)
-      (with-exception-handler
-       (lambda (obj)
-        (and (uncaught-exception? obj)
-             (eq? (uncaught-exception-reason obj) 'foo)
-             (set! success #t)))
-       (lambda () (thread-join! t)))
-      success))
-
-  (pass-if "initial handler captures non-SRFI-18 throw"
-    (let ((t (make-thread (lambda () (throw 'foo))))
-         (success #f))
-      (thread-start! t)
-      (with-exception-handler
-       (lambda (obj)
-        (and (uncaught-exception? obj)
-             (eq? (uncaught-exception-reason obj) 'foo)
-             (set! success #t)))
-       (lambda () (thread-join! t)))
-      success)))
-
-)
+    (pass-if "condition-variable-signal! wakes up single thread"
+      (let* ((m (make-mutex 'condition-variable-signal-1))
+             (c (make-condition-variable 'condition-variable-signal-1))
+             (t (make-thread (lambda () 
+                               (mutex-lock! m) 
+                               (condition-variable-signal! c) 
+                               (mutex-unlock! m)))))
+        (mutex-lock! m)
+        (thread-start! t)
+        (mutex-unlock! m c))))
+
+  (with-test-prefix "condition-variable-broadcast!"
+
+    (pass-if "condition-variable-broadcast! wakes up multiple threads"
+      (let* ((sem 0)
+             (c1 (make-condition-variable 'condition-variable-broadcast-1-a))
+             (m1 (make-mutex 'condition-variable-broadcast-1-a))
+             (c2 (make-condition-variable 'condition-variable-broadcast-1-b))
+             (m2 (make-mutex 'condition-variable-broadcast-1-b))
+             (inc-sem! (lambda () 
+                         (mutex-lock! m1)
+                         (set! sem (+ sem 1))
+                         (condition-variable-broadcast! c1)
+                         (mutex-unlock! m1)))
+             (dec-sem! (lambda ()
+                         (mutex-lock! m1)
+                         (while (eqv? sem 0) (wait-condition-variable c1 m1))
+                         (set! sem (- sem 1))
+                         (mutex-unlock! m1)))
+             (t1 (make-thread (lambda () 
+                                (mutex-lock! m2)
+                                (inc-sem!)
+                                (mutex-unlock! m2 c2)
+                                (inc-sem!))))
+             (t2 (make-thread (lambda () 
+                                (mutex-lock! m2)
+                                (inc-sem!)
+                                (mutex-unlock! m2 c2)
+                                (inc-sem!)))))
+        (thread-start! t1)
+        (thread-start! t2)
+        (dec-sem!)
+        (dec-sem!)
+        (mutex-lock! m2)
+        (condition-variable-broadcast! c2)
+        (mutex-unlock! m2)
+        (dec-sem!)
+        (dec-sem!))))
+
+  (with-test-prefix "time?"
+
+    (pass-if "current-time is time" (time? (current-time)))
+    (pass-if "number is not time" (not (time? 123)))
+    (pass-if "symbol not time" (not (time? 'foo))))
+
+  (with-test-prefix "time->seconds"
+
+    (pass-if "time->seconds makes time into rational"
+      (rational? (time->seconds (current-time))))
+
+    (pass-if "time->seconds is reversible"
+      (let ((t (current-time)))
+        (equal? t (seconds->time (time->seconds t))))))
+
+  (with-test-prefix "seconds->time"
+
+    (pass-if "seconds->time makes rational into time"
+      (time? (seconds->time 123.456)))
+
+    (pass-if "seconds->time is reversible"
+      (let ((t (time->seconds (current-time))))
+        (equal? t (time->seconds (seconds->time t))))))
+
+  (with-test-prefix "current-exception-handler"
+
+    (pass-if "current handler returned at top level"
+      (procedure? (current-exception-handler)))
+
+    (pass-if "specified handler set under with-exception-handler"
+      (let ((h (lambda (key . args) 'nothing)))
+        (with-exception-handler h (lambda () (eq? (current-exception-handler) 
+                                                  h)))))
+
+    (pass-if "multiple levels of handler nesting"
+      (let ((h (lambda (key . args) 'nothing))
+            (i (current-exception-handler)))
+        (and (with-exception-handler h (lambda () 
+                                         (eq? (current-exception-handler) h)))
+             (eq? (current-exception-handler) i))))
+
+    (pass-if "exception handler installation is thread-safe"
+      (let* ((h1 (current-exception-handler))
+             (h2 (lambda (key . args) 'nothing-2))
+             (m (make-mutex 'current-exception-handler-4))
+             (c (make-condition-variable 'current-exception-handler-4))
+             (t (make-thread (lambda () 
+                               (with-exception-handler 
+                                h2 (lambda () 
+                                     (mutex-lock! m) 
+                                     (condition-variable-signal! c) 
+                                     (wait-condition-variable c m)
+                                     (and (eq? (current-exception-handler) h2)
+                                          (mutex-unlock! m)))))
+                             'current-exception-handler-4)))
+        (mutex-lock! m)
+        (thread-start! t)
+        (wait-condition-variable c m)
+        (and (eq? (current-exception-handler) h1)
+             (condition-variable-signal! c)
+             (mutex-unlock! m)
+             (thread-join! t)))))
+
+  (with-test-prefix "uncaught-exception-reason"
+
+    (pass-if "initial handler captures top level exception"
+      (let ((t (make-thread (lambda () (raise 'foo))))
+            (success #f))
+        (thread-start! t)
+        (with-exception-handler
+         (lambda (obj)
+           (and (uncaught-exception? obj)
+                (eq? (uncaught-exception-reason obj) 'foo)
+                (set! success #t)))
+         (lambda () (thread-join! t)))
+        success))
+
+    (pass-if "initial handler captures non-SRFI-18 throw"
+      (let ((t (make-thread (lambda () (throw 'foo))))
+            (success #f))
+        (thread-start! t)
+        (with-exception-handler
+         (lambda (obj)
+           (and (uncaught-exception? obj)
+                (eq? (uncaught-exception-reason obj) 'foo)
+                (set! success #t)))
+         (lambda () (thread-join! t)))
+        success)))))
\ No newline at end of file


hooks/post-receive
-- 
GNU Guile