diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-03-05 11:41:42 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-03-05 13:38:57 +0100 |
commit | c02924d02b4b78998b380deb20a4fd2d5fc3cfbb (patch) | |
tree | 6d608399dae5db4280198f6e8407d4ec4ca6c88f | |
parent | e2cf8eb921a4dd12af5024861e2b2bfc0b90a1ed (diff) | |
download | guile-c02924d02b4b78998b380deb20a4fd2d5fc3cfbb.tar.gz |
Add new fluid tests.
* test-suite/tests/fluids.test ("initial fluid values")["initial value
is inherited from parent thread"]: New test.
("fluid values are thread-local"): New test.
-rw-r--r-- | test-suite/tests/fluids.test | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/test-suite/tests/fluids.test b/test-suite/tests/fluids.test index 51353fa47..3784e548b 100644 --- a/test-suite/tests/fluids.test +++ b/test-suite/tests/fluids.test @@ -27,7 +27,19 @@ (with-test-prefix "initial fluid values" (pass-if "fluid-ref uninitialized fluid is #f" - (not (fluid-ref a)))) + (not (fluid-ref a))) + + (pass-if "initial value is inherited from parent thread" + (if (provided? 'threads) + (let ((f (make-fluid))) + (fluid-set! f 'initial) + (let ((child (call-with-new-thread + (lambda () + (let ((init (fluid-ref f))) + (fluid-set! f 'new) + (list init (fluid-ref f))))))) + (equal? '(initial new) (join-thread child)))) + (throw 'unresolved)))) (with-test-prefix "with-fluids with non-fluid" (pass-if-exception "exception raised if nonfluid passed to with-fluids" @@ -56,6 +68,18 @@ (eqv? (fluid-ref a) 2)) (eqv? (fluid-ref a) #f)))) +(pass-if "fluid values are thread-local" + (if (provided? 'threads) + (let ((f (make-fluid))) + (fluid-set! f 'parent) + (let ((child (call-with-new-thread + (lambda () + (fluid-set! f 'child) + (fluid-ref f))))) + (and (eq? (join-thread child) 'child) + (eq? (fluid-ref f) 'parent)))) + (throw 'unresolved))) + (pass-if "fluids are GC'd" (let ((g (make-guardian))) |