(load-relative "../pool.scm")
(import pool)
(use test srfi-18)

(define pool (make-pool '(foo bar baz)))

(test 'foo (call-with-value-from-pool pool identity))
(test 'foo (call-with-value-from-pool pool identity))

(test 'foo (call-with-value-from-pool pool 
	     (lambda (v)
	       (call-with-value-from-pool pool 
		 (lambda (v)
		   (call-with-value-from-pool pool identity))))))

(test 'baz (call-with-value-from-pool pool 
	     (lambda (v)
	       (thread-join! (call-with-value-from-pool-in-thread pool
			       (lambda (v)
				 (thread-join! (call-with-value-from-pool-in-thread pool identity))))))))


(test "returning false from the proc" #f (call-with-value-from-pool pool (constantly #f)))

(test-error "deadlock"
	    (let ((pool (make-pool '(a))))
	      (call-with-value-from-pool pool 
		(lambda (v)
		  (thread-join! 
		   (call-with-value-from-pool-in-thread pool identity))))))
(let* ((value 0)
       (pool (make-pool '(1))))
  (for-each (lambda (i)
	      (call-with-value-from-pool-in-thread pool
		(lambda (v)
		  (set! value (add1 value)))))
	    (list-tabulate 10 (constantly 1)))

  (let loop ((threads (##sys#all-threads)))
    (unless (null? threads)
      (thread-join! (car threads))
      (loop (##sys#all-threads))))

  (test 10 value))


;; this one is left to fail - it needs dynamic-wind to be fixed but I couldn't make it work so far

;; (let ((jump #f)
;;       (done #f))

;;   (call-with-value-from-pool pool 
;;     (lambda (v)
;;       (call/cc (lambda (c)
;; 		 (set! jump c)))

;;       (when done
;; 	(test "value is still locked" 'foo (alist-ref (current-thread) (pool-locked-values pool))))))
  
;;   (unless done 
;;     (set! done #t)
;;     (call-with-value-from-pool-in-thread pool (lambda (v) (thread-suspend! (current-thread))))
;;     (jump #t)))

(test-exit)