-IN: concurrency.locks.tests\r
USING: tools.test concurrency.locks concurrency.count-downs\r
concurrency.messaging concurrency.mailboxes locals kernel\r
threads sequences calendar accessors ;\r
+IN: concurrency.locks.tests\r
\r
-:: lock-test-0 ( -- )\r
+:: lock-test-0 ( -- v )\r
[let | v [ V{ } clone ]\r
c [ 2 <count-down> ] |\r
\r
v\r
] ;\r
\r
-:: lock-test-1 ( -- )\r
+:: lock-test-1 ( -- v )\r
[let | v [ V{ } clone ]\r
l [ <lock> ]\r
c [ 2 <count-down> ] |\r
\r
[ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test\r
\r
-:: rw-lock-test-1 ( -- )\r
+:: rw-lock-test-1 ( -- v )\r
[let | l [ <rw-lock> ]\r
c [ 1 <count-down> ]\r
c' [ 1 <count-down> ]\r
c await\r
l [\r
4 v push\r
- 1000 sleep\r
+ 1 seconds sleep\r
5 v push\r
] with-write-lock\r
c'' count-down\r
\r
[ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test\r
\r
-:: rw-lock-test-2 ( -- )\r
+:: rw-lock-test-2 ( -- v )\r
[let | l [ <rw-lock> ]\r
c [ 1 <count-down> ]\r
c' [ 2 <count-down> ]\r
l [\r
1 v push\r
c count-down\r
- 1000 sleep\r
+ 1 seconds sleep\r
2 v push\r
] with-write-lock\r
c' count-down\r
[ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test\r
\r
! Test lock timeouts\r
-:: lock-timeout-test ( -- )\r
+:: lock-timeout-test ( -- v )\r
[let | l [ <lock> ] |\r
[\r
l [ 1 seconds sleep ] with-lock\r
] ;\r
\r
[ lock-timeout-test ] [\r
- linked-error-thread name>> "Lock timeout-er" =\r
+ thread>> name>> "Lock timeout-er" =\r
] must-fail-with\r
\r
-:: read/write-test ( -- )\r
- [let | l [ <lock> ] |\r
- [\r
- l [ 1 seconds sleep ] with-lock\r
- ] "Lock holder" spawn drop\r
-\r
- [\r
- l 1/10 seconds [ ] with-lock-timeout\r
- ] "Lock timeout-er" spawn-linked drop\r
-\r
- receive\r
- ] ;\r
-\r
[\r
<rw-lock> dup [\r
1 seconds [ ] with-write-lock-timeout\r