(load-relative "../zmq.so")
(load-relative "../zmq.import.so")
(import zmq)
(use test srfi-18)

(test-group "contexts"
  (test-assert (context? (make-context 1)))
  (test-error (make-context -1)))

(test-group "messages"
  (test 0 (message-size (make-message)))
  (test 2 (message-size (make-message 2)))
  (test 6 (message-size (make-message "foobar")))
  (test "foo" (message->string (make-message "foo")))
  (test "abc" (message->string (copy-message (make-message "abc")))))

(define make-bound-socket-pair
    (let ((count 0))
      (lambda (server client)
        (let ((s (make-socket server))
              (c (make-socket client))
              (e (conc "inproc://test" count)))
          (bind-socket s e)
          (connect-socket c e)
          (thread-sleep! 0.2)           ; needed for 0MQ 2.0
          (set! count (add1 count))
          (values s c)))))

(test-group "sockets"

  (test-group "default-context"
    (test-assert (not (zmq-default-context)))
    (make-socket 'rep)
    (test-assert (context? (zmq-default-context))))

  (test-group "options"
    (let ((s (make-socket 'pull)))
      (test 0 (socket-option s 'hwm))
      (socket-option-set! s 'hwm 100)
      (test 100 (socket-option s 'hwm))
      (test #t (socket-option s 'mcast-loop))
      (socket-option-set! s 'identity "yes")
      (test "yes" (socket-option s 'identity))))

  (test-group "push/pull"
    (receive (push pull) 
      (make-bound-socket-pair 'push 'pull)
      (send-message push (make-message "hey"))
      (test "hey" (message->string (receive-message pull)))
      (send-message push "ho")
      (test "ho" (message->string (receive-message pull)))
      (test-error (receive-message push))
      (test-error (send-message pull "impossible"))))

  (test-group "pub/sub"
    (receive (pub sub)
      (make-bound-socket-pair 'pub 'sub)
      (socket-option-set! sub 'subscribe "foo")
      (send-message pub "foo bar!")
      (test "foo bar!" (message->string (receive-message sub)))
      (send-message pub "bar!")
      (test-assert (not (receive-message sub non-blocking: #t)))))

  (test-group "rep/req"
    (receive (rep req)
      (make-bound-socket-pair 'rep 'req)
      (send-message req "foo")
      (test "foo" (message->string (receive-message rep)))
      (send-message rep "bar")
      (test "bar" (message->string (receive-message req)))
      (test-error (receive-message req))
      (test-error (send-message rep "nope"))))

  (test-group "non-blocking read"
    (receive (a b)
      (make-bound-socket-pair 'push 'pull)
      (test-assert (not (receive-message b non-blocking: #t)))
      (send-message a "foo bar!")
      (test "foo bar!" (message->string (receive-message b non-blocking: #t)))))

  ;; this is to test the context finalizer; if it doesn't work, a
  ;; double-free error will be raised after the tests have finished
  (define some-socket (make-socket 'push))
  (close-socket some-socket))

(test-group "polling"
  (receive (a b)
    (make-bound-socket-pair 'push 'pull)

    (let* ((c (make-socket 'pull))
           (d (make-socket 'pull))
           (pis (map (cut make-poll-item <> in: #t) (list b c d))))

      (test 0 (poll pis #f))
      (send-message a "check")
      (test 1 (poll pis #t))
      (test 1 (length (filter poll-item-in? pis))))))

(unless (zero? (test-failure-count)) (exit 1))