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

srfi-18 test fix

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2012-02-24 20:01:47 +01:00
parent 006163e02f
commit a850c3ccc4
1 changed files with 373 additions and 376 deletions
Download patch file Download diff file Expand all files Collapse all files

63
test-suite/tests/srfi-18.test
View file

@ -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,15 +25,14 @@
(if (provided? 'threads)
(use-modules (srfi srfi-18)))
(and
(provided? 'threads)
(with-test-prefix "current-thread"
(cond
((provided? 'threads)
(with-test-prefix "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)))
@ -41,7 +40,7 @@
(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)))
@ -49,7 +48,7 @@
(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))
@ -61,7 +60,7 @@
(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))
@ -74,7 +73,7 @@
(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)
@ -82,12 +81,12 @@
(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))
(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))))
@ -101,7 +100,7 @@
(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))
@ -134,7 +133,7 @@
(lambda () (thread-join! t)))
success)))
(with-test-prefix "thread-join!"
(with-test-prefix "thread-join!"
(pass-if "join receives result of thread"
(let ((t (make-thread (lambda () 'foo) 'thread-join-1)))
@ -167,7 +166,7 @@
(thread-start! t)
(eq? (thread-join! t (+ (time->seconds (current-time)) 2)) 'foo))))
(with-test-prefix "mutex?"
(with-test-prefix "mutex?"
(pass-if "make-mutex creates mutex"
(mutex? (make-mutex)))
@ -175,7 +174,7 @@
(pass-if "symbol not mutex"
(not (mutex? 'foo))))
(with-test-prefix "mutex-name"
(with-test-prefix "mutex-name"
(pass-if "make-mutex with name binds name"
(let* ((m (make-mutex 'mutex-name-1)))
@ -185,7 +184,7 @@
(let* ((m (make-mutex)))
(not (mutex-name m)))))
(with-test-prefix "mutex-specific"
(with-test-prefix "mutex-specific"
(pass-if "mutex-specific is initially #f"
(let ((m (make-mutex 'mutex-specific-1)))
@ -196,7 +195,7 @@
(mutex-specific-set! m "hello")
(equal? (mutex-specific m) "hello"))))
(with-test-prefix "mutex-state"
(with-test-prefix "mutex-state"
(pass-if "mutex state is initially not-abandoned"
(let ((m (make-mutex 'mutex-state-1)))
@ -219,7 +218,7 @@
(thread-join! t)
(eq? (mutex-state m) 'abandoned))))
(with-test-prefix "mutex-lock!"
(with-test-prefix "mutex-lock!"
(pass-if "mutex-lock! returns true on successful lock"
(let* ((m (make-mutex 'mutex-lock-1)))
@ -280,7 +279,7 @@
(lambda () (mutex-unlock! m1 c) (mutex-lock! m2)))
success)))
(with-test-prefix "mutex-unlock!"
(with-test-prefix "mutex-unlock!"
(pass-if "unlock changes mutex state"
(let* ((m (make-mutex 'mutex-unlock-1)))
@ -313,7 +312,7 @@
(mutex-lock! m)
(not (mutex-unlock! m c (+ (time->seconds (current-time)) 1))))))
(with-test-prefix "condition-variable?"
(with-test-prefix "condition-variable?"
(pass-if "make-condition-variable creates condition variable"
(condition-variable? (make-condition-variable)))
@ -321,7 +320,7 @@
(pass-if "symbol not condition variable"
(not (condition-variable? 'foo))))
(with-test-prefix "condition-variable-name"
(with-test-prefix "condition-variable-name"
(pass-if "make-condition-variable with name binds name"
(let* ((c (make-condition-variable 'condition-variable-name-1)))
@ -331,7 +330,7 @@
(let* ((c (make-condition-variable)))
(not (condition-variable-name c)))))
(with-test-prefix "condition-variable-specific"
(with-test-prefix "condition-variable-specific"
(pass-if "condition-variable-specific is initially #f"
(let ((c (make-condition-variable 'condition-variable-specific-1)))
@ -342,7 +341,7 @@
(condition-variable-specific-set! c "hello")
(equal? (condition-variable-specific c) "hello"))))
(with-test-prefix "condition-variable-signal!"
(with-test-prefix "condition-variable-signal!"
(pass-if "condition-variable-signal! wakes up single thread"
(let* ((m (make-mutex 'condition-variable-signal-1))
@ -355,7 +354,7 @@
(thread-start! t)
(mutex-unlock! m c))))
(with-test-prefix "condition-variable-broadcast!"
(with-test-prefix "condition-variable-broadcast!"
(pass-if "condition-variable-broadcast! wakes up multiple threads"
(let* ((sem 0)
@ -393,13 +392,13 @@
(dec-sem!)
(dec-sem!))))
(with-test-prefix "time?"
(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"
(with-test-prefix "time->seconds"
(pass-if "time->seconds makes time into rational"
(rational? (time->seconds (current-time))))
@ -408,7 +407,7 @@
(let ((t (current-time)))
(equal? t (seconds->time (time->seconds t))))))
(with-test-prefix "seconds->time"
(with-test-prefix "seconds->time"
(pass-if "seconds->time makes rational into time"
(time? (seconds->time 123.456)))
@ -417,7 +416,7 @@
(let ((t (time->seconds (current-time))))
(equal? t (time->seconds (seconds->time t))))))
(with-test-prefix "current-exception-handler"
(with-test-prefix "current-exception-handler"
(pass-if "current handler returned at top level"
(procedure? (current-exception-handler)))
@ -456,7 +455,7 @@
(mutex-unlock! m)
(thread-join! t)))))
(with-test-prefix "uncaught-exception-reason"
(with-test-prefix "uncaught-exception-reason"
(pass-if "initial handler captures top level exception"
(let ((t (make-thread (lambda () (raise 'foo))))
@ -480,6 +479,4 @@
(eq? (uncaught-exception-reason obj) 'foo)
(set! success #t)))
(lambda () (thread-join! t)))
success)))
)
success)))))