(use srfi-18 extras ports posix)

;(define proc-under-test (cut read-string 2)) ; Read one character plus newline.
;(define proc-under-test read-char)

;(define (srfi-18-read-char #!optional (port (current-input-port)))
;  (thread-wait-for-i/o!
;    (port->fileno port)
;    #:input)
;  (read-char port))
;
;(define proc-under-test srfi-18-read-char)


(let* ((orig read-char)
       (new
	 (lambda (#!optional (port (current-input-port)))
	   (thread-wait-for-i/o!
	     (port->fileno port)
	     #:input)
	   (orig port))))
  (set!
    read-char
    new))

(define proc-under-test read-char)



(define (count!)
  (let ((me (thread-name (current-thread))))
    (let loop ((n 0))
      (printf "~S: ~S\n" me n)
      (thread-sleep! 1)
      (loop (add1 n)))))

(define (test-proc)
  (let ((me (thread-name (current-thread))))
    (thread-sleep! 5)
    (printf "~S: Enter Character\n" me)
    (printf "~S: read ~S\n"
	    me
	    (proc-under-test))))


(thread-start!
  (make-thread
    count!))

; Test the behaviour in the primordial thread
(test-proc)

; Test the behaviour in a srfi-18 thread
(thread-start!
  (make-thread
    test-proc))

(count!)