;;;; timed-resource-test.scm

;;;

(import test)

;;

;
(define (gloss fmt . args)
  (import (only (chicken base) flush-output))
  (import (only (chicken format) printf))
  (apply printf fmt args)
  ;important!
  (flush-output) )

;
(define (countdown-gloss secs)
  (import (srfi 18))
  (gloss "Sleeping ~A secs~A" secs #\return)
  (thread-sleep! secs) )

#; ;FIXME Gloss API?
(define countdown-gloss (o gloss countdown seconds))

;;;

#; ;
(define (bytes-per-bits x) (inexact->exact (floor (/ (+ x 7) 8))))

;;

(define-syntax inc!
  (syntax-rules ()
    ((inc! ?loc)
      (let ((val ?loc))
        (set! ?loc (add1 val)) ) ) ) )

;;

(define (read-blob u8cnt #!optional (port (current-input-port)))
  (import (srfi 4))
  (u8vector->blob (read-u8vector u8cnt port)) )

;;;

(import timed-resource)
(import (chicken blob))

(define-constant ACTIVE-SECONDS 1.0)
(define-constant BUFFER-BYTES 16)

(define +opened+ 0)
(define +closed+ 0)

(define (timed-random-blob opener)
  (let (
    (+tr+
      (make-timed-resource
        (lambda ()
          (let ((port (opener)))
            (test-assert "Resource Opened" port)
            (inc! +opened+)
            port ) )
        (lambda (port)
          (close-output-port port)
          (inc! +closed+) )
        ACTIVE-SECONDS)) )
    (lambda (#!optional (bytes 16))
      (with-timed-resource +tr+
        (cut read-blob bytes <>)) ) ) )

;;;

;; Config

(cond-expand
  (windows
    ;;FIXME a windows file to read
    (define (open-test-port)
      #f ) )
  (unix
    (define (open-test-port)
      (open-input-file "/dev/random" #:binary) ) ) )

;; Test

(test-group "Simple Timed Resource"

  (let (
    (x ((timed-random-blob open-test-port) BUFFER-BYTES)) )
    (test-assert "Resource Read Type" (blob? x))
    (test "Resource Read Size" BUFFER-BYTES (blob-size x)) )

  ;Wait a little longer than the timeout
  (countdown-gloss (+ ACTIVE-SECONDS 0.5))

  ;Better be closed now!
  (test "Resource Closed" +closed+ +opened+) )

;;;

(test-exit)