;;;; synch test

(use
  test
  synch
  srfi-18
  miscmacros)

;;;

(define-record-type <foo>
  (make-<foo> x y mtx)
  <foo>?
  (x <foo>-x)
  (y <foo>-y)
  (mtx <foo>-mutex))

(let ((tfoo (make-<foo> 1 2 (make-mutex))))
  (test "record-synch" '(1 2)
    (record-synch tfoo <foo> (list (<foo>-x tfoo) (<foo>-y tfoo)))) )

;;; Synchronize thread access to an object

(test-begin "hash-table synch")

;;

(define-syntax define-thread
	(syntax-rules ()
	  ((_ ?ident ?body ...)
	    (define ?ident
        (make-thread
          (lambda () ?body ...)
          '?ident) ) ) ) )

;;

(use srfi-69)

(define (hash-table-count ht)
  (##sys#check-structure ht 'hash-table 'hash-table-count)
  (hash-table-fold ht (lambda (k v a) (fx+ a 1)) 0) )

;;

(define-constructor-synch make-hash-table)
(define-predicate-synch hash-table?)
(define-operation-synch hash-table-count)
(define-operation-synch hash-table-set!)

;;

(define +tht+ (make-hash-table-synch = number-hash))

(define-constant READER-THREAD-LIMIT 20)

(define-constant THREAD-SLEEP-MS 0)
(define-constant READ-FACTOR 1)
(define-constant WRITE-FACTOR 1)

;; Greedy Reader

(define-thread reader-thread
  (do ((n (hash-table-count-synch +tht+) (hash-table-count-synch +tht+)))
      ((fx= READER-THREAD-LIMIT n)
        (print "test hash-table count = " n " so quit"))
    (print "test hash-table count = " n)
    (thread-sleep! (fx* READ-FACTOR THREAD-SLEEP-MS)) ) )

;; Cooperative Writer

(define-thread writer-thread
  (repeat* 10
    (hash-table-set!-synch +tht+ it (number->string it))
    (hash-table-set!-synch +tht+ (* it 11) (number->string it))
    (thread-sleep! (fx* WRITE-FACTOR THREAD-SLEEP-MS))
    (thread-yield!) ) )

(thread-start! writer-thread)
(thread-start! reader-thread)

(thread-join! writer-thread)
(thread-join! reader-thread)

(test-end "hash-table synch")

;;

#;(use critical-region)

#;(test-assert (critical-region #t))

;;;

(test-exit)