Megatest

File nng-trial/nng-test.scm artifact 3d0cf92ae9 part of check-in 3b6efca64a

(import (chicken io)
        (chicken string)
	(chicken process-context)
	(chicken process-context posix)
        miscmacros
        nng
        srfi-18
        test
	matchable
	typed-records)

(define help "Usage: nng-test COMMAND
  where COMMAND is one of:
    dotest    : run the basic req/rep test
")

(define address-tcp-1 "tcp://localhost:5555")
(define address-tcp-2 "tcp://localhost:6666")

(define address-inproc-1 "inproc://local1")
(define address-inproc-2 "inproc://local2")

;;;
;;; Req-Rep
;;;
(define (make-listening-reply-socket address)
  (let ((socket (make-rep-socket)))
    (socket-set! socket 'nng/recvtimeo 2000)
    (nng-listen socket address)
    socket))

(define (make-dialed-request-socket address)
  (let ((socket (make-req-socket)))
    (socket-set! socket 'nng/recvtimeo 2000)
    (nng-dial socket address)
    socket))

(define (req-rep-test address)
  (let ((rep (make-listening-reply-socket address))
        (req (make-dialed-request-socket address)))
    (nng-send req "message 1")
    (nng-recv rep)
    (nng-send rep "message")
    (begin0
     (nng-recv req)
     (nng-close! rep))))

(define (do-test)
  (test-group "nng"
              (test "tcp req-rep"
                    "message"
                    (req-rep-test address-tcp-1))
              (test "inproc req-rep"
                    "message"
                    (req-rep-test address-inproc-1)))
  (test-exit))

(defstruct srv
  myaddr
  remaddr
  req
  rep
  name)

(define (server-setup myname myaddr remoteaddr)
  (let* ((srvdat (make-srv)))
    (srv-myaddr-set! srvdat myaddr)
    (srv-remaddr-set! srvdat remoteaddr)
    (srv-rep-set! srvdat (make-listening-reply-socket myaddr))
    (srv-req-set! srvdat (make-dialed-request-socket myaddr))
    (srv-name-set! srvdat myname)
    srvdat))

(define (send-n-messages n srvdat)
  (let* ((name (srv-name srvdat)))
    (let loop ((i 0))
      (if (< i n)
	  (begin
	    (print "send: "(nng-send (srv-req srvdat) (conc name "-" i)))
	    (print "receive: "(nng-recv (srv-rep srvdat)))
	    (loop (+ i 1)))))))

(define (close-srv srvdat)
  (nng-close! (srv-rep srvdat)))
    
(match
 (command-line-arguments)
 (("do-test")(do-test))
 (("send-n" n myaddr toaddr)
  (let ((n-num (string->number n))
	(sdat  (server-setup "just testing" myaddr toaddr)))
    (send-n-messages n-num sdat)
    (close-srv sdat)))
 ((cmd)(print "ERROR: command "cmd", not recognised.\n\n"help))
 (else
  (print help)))