summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-03-05 11:41:42 +0100
committerLudovic Courtès <ludo@gnu.org>2010-03-05 13:38:57 +0100
commitc02924d02b4b78998b380deb20a4fd2d5fc3cfbb (patch)
tree6d608399dae5db4280198f6e8407d4ec4ca6c88f
parente2cf8eb921a4dd12af5024861e2b2bfc0b90a1ed (diff)
downloadguile-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.test26
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)))