source: project/release/4/synch/trunk/tests/synch-test.scm @ 35094

Last change on this file since 35094 was 35094, checked in by kon, 10 months ago

still obtuse

File size: 1.8 KB
Line 
1;;;; synch test
2
3(use
4  test
5  synch
6  srfi-18
7  miscmacros)
8
9;;;
10
11(define-record-type <foo>
12  (make-<foo> x y mtx)
13  <foo>?
14  (x <foo>-x)
15  (y <foo>-y)
16  (mtx <foo>-mutex))
17
18(let ((tfoo (make-<foo> 1 2 (make-mutex))))
19  (test "record-synch" '(1 2)
20    (record-synch tfoo <foo> (list (<foo>-x tfoo) (<foo>-y tfoo)))) )
21
22;;; Synchronize thread access to an object
23
24(test-begin "hash-table synch")
25
26;;
27
28(define-syntax define-thread
29        (syntax-rules ()
30          ((_ ?ident ?body ...)
31            (define ?ident
32        (make-thread
33          (lambda () ?body ...)
34          '?ident) ) ) ) )
35
36;;
37
38(use srfi-69)
39
40(define (hash-table-count ht)
41  (##sys#check-structure ht 'hash-table 'hash-table-count)
42  (hash-table-fold ht (lambda (k v a) (fx+ a 1)) 0) )
43
44;;
45
46(define-constructor-synch make-hash-table)
47(define-predicate-synch hash-table?)
48(define-operation-synch hash-table-count)
49(define-operation-synch hash-table-set!)
50
51;;
52
53(define +tht+ (make-hash-table-synch = number-hash))
54
55(define-constant READER-THREAD-LIMIT 20)
56
57(define-constant THREAD-SLEEP-MS 0)
58(define-constant READ-FACTOR 1)
59(define-constant WRITE-FACTOR 1)
60
61;; Greedy Reader
62
63(define-thread reader-thread
64  (do ((n (hash-table-count-synch +tht+) (hash-table-count-synch +tht+)))
65      ((fx= READER-THREAD-LIMIT n)
66        (print "test hash-table count = " n " so quit"))
67    (print "test hash-table count = " n)
68    (thread-sleep! (fx* READ-FACTOR THREAD-SLEEP-MS)) ) )
69
70;; Cooperative Writer
71
72(define-thread writer-thread
73  (repeat* 10
74    (hash-table-set!-synch +tht+ it (number->string it))
75    (hash-table-set!-synch +tht+ (* it 11) (number->string it))
76    (thread-sleep! (fx* WRITE-FACTOR THREAD-SLEEP-MS))
77    (thread-yield!) ) )
78
79(thread-start! writer-thread)
80(thread-start! reader-thread)
81
82(thread-join! writer-thread)
83(thread-join! reader-thread)
84
85(test-end "hash-table synch")
86
87;;
88
Note: See TracBrowser for help on using the repository browser.