;;;; synch-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(use test)

(test-begin "Synch")

;;;

(use
  synch
  srfi-18
  miscmacros)

;;;

(test-begin "record synch")

(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)))) )

(test-end "record synch")

;;; Synchronize

(test-begin "exception synch")

(let ((mx1 (make-mutex 'mx1)))

  (define (f x) (abort 'ca1))
  ;(define (f x) (signal 'cs1))

  (handle-exceptions exn
    (begin
      ;(test "expected exception" 'ca1 ((lambda () exn)))
      (test "mutex unlocked (after exception handled!)" 'not-abandoned (mutex-state mx1)) )
    (synch mx1
      (f 1) ) )

  (mutex-lock! mx1)
  (test-assert "mutex locked" (thread? (mutex-state mx1)))
  (mutex-unlock! mx1)
  (test "mutex unlocked" 'not-abandoned (mutex-state mx1))
)

(test-end "exception synch")

;;; 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-end "Synch")

(test-exit)