1 USING: tools.test concurrency.locks concurrency.count-downs
2 concurrency.messaging concurrency.mailboxes locals kernel
3 threads sequences calendar accessors ;
4 IN: concurrency.locks.tests
6 :: lock-test-0 ( -- v )
16 ] "Lock test 1" spawn drop
24 ] "Lock test 2" spawn drop
29 :: lock-test-1 ( -- v )
42 ] "Lock test 1" spawn drop
52 ] "Lock test 2" spawn drop
57 [ V{ 1 3 2 4 } ] [ lock-test-0 ] unit-test
58 [ V{ 1 2 3 4 } ] [ lock-test-1 ] unit-test
61 <reentrant-lock> dup [
68 [ ] [ <rw-lock> drop ] unit-test
70 [ ] [ <rw-lock> [ ] with-read-lock ] unit-test
72 [ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-read-lock ] unit-test
74 [ ] [ <rw-lock> [ ] with-write-lock ] unit-test
76 [ ] [ <rw-lock> dup [ [ ] with-write-lock ] with-write-lock ] unit-test
78 [ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test
80 :: rw-lock-test-1 ( -- v )
95 ] "R/W lock test 1" spawn drop
105 ] "R/W lock test 2" spawn drop
114 ] "R/W lock test 4" spawn drop
122 ] "R/W lock test 5" spawn drop
127 [ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test
129 :: rw-lock-test-2 ( -- v )
143 ] "R/W lock test 1" spawn drop
151 ] "R/W lock test 2" spawn drop
156 [ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test
159 :: lock-timeout-test ( -- v )
163 l [ 1 seconds sleep ] with-lock
164 ] "Lock holder" spawn drop
167 l 1/10 seconds [ ] with-lock-timeout
168 ] "Lock timeout-er" spawn-linked drop
172 [ lock-timeout-test ] [
173 thread>> name>> "Lock timeout-er" =
178 1 seconds [ ] with-write-lock-timeout
185 1 seconds [ ] with-write-lock-timeout
193 1 seconds [ ] with-read-lock-timeout