Megatest

Hex Artifact Content
Login

Artifact 3d0cf92ae936534ca3609d3945e8d43a4709fe79:


0000: 28 69 6d 70 6f 72 74 20 28 63 68 69 63 6b 65 6e  (import (chicken
0010: 20 69 6f 29 0a 20 20 20 20 20 20 20 20 28 63 68   io).        (ch
0020: 69 63 6b 65 6e 20 73 74 72 69 6e 67 29 0a 09 28  icken string)..(
0030: 63 68 69 63 6b 65 6e 20 70 72 6f 63 65 73 73 2d  chicken process-
0040: 63 6f 6e 74 65 78 74 29 0a 09 28 63 68 69 63 6b  context)..(chick
0050: 65 6e 20 70 72 6f 63 65 73 73 2d 63 6f 6e 74 65  en process-conte
0060: 78 74 20 70 6f 73 69 78 29 0a 20 20 20 20 20 20  xt posix).      
0070: 20 20 6d 69 73 63 6d 61 63 72 6f 73 0a 20 20 20    miscmacros.   
0080: 20 20 20 20 20 6e 6e 67 0a 20 20 20 20 20 20 20       nng.       
0090: 20 73 72 66 69 2d 31 38 0a 20 20 20 20 20 20 20   srfi-18.       
00a0: 20 74 65 73 74 0a 09 6d 61 74 63 68 61 62 6c 65   test..matchable
00b0: 0a 09 74 79 70 65 64 2d 72 65 63 6f 72 64 73 29  ..typed-records)
00c0: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 22  ..(define help "
00d0: 55 73 61 67 65 3a 20 6e 6e 67 2d 74 65 73 74 20  Usage: nng-test 
00e0: 43 4f 4d 4d 41 4e 44 0a 20 20 77 68 65 72 65 20  COMMAND.  where 
00f0: 43 4f 4d 4d 41 4e 44 20 69 73 20 6f 6e 65 20 6f  COMMAND is one o
0100: 66 3a 0a 20 20 20 20 64 6f 74 65 73 74 20 20 20  f:.    dotest   
0110: 20 3a 20 72 75 6e 20 74 68 65 20 62 61 73 69 63   : run the basic
0120: 20 72 65 71 2f 72 65 70 20 74 65 73 74 0a 22 29   req/rep test.")
0130: 0a 0a 28 64 65 66 69 6e 65 20 61 64 64 72 65 73  ..(define addres
0140: 73 2d 74 63 70 2d 31 20 22 74 63 70 3a 2f 2f 6c  s-tcp-1 "tcp://l
0150: 6f 63 61 6c 68 6f 73 74 3a 35 35 35 35 22 29 0a  ocalhost:5555").
0160: 28 64 65 66 69 6e 65 20 61 64 64 72 65 73 73 2d  (define address-
0170: 74 63 70 2d 32 20 22 74 63 70 3a 2f 2f 6c 6f 63  tcp-2 "tcp://loc
0180: 61 6c 68 6f 73 74 3a 36 36 36 36 22 29 0a 0a 28  alhost:6666")..(
0190: 64 65 66 69 6e 65 20 61 64 64 72 65 73 73 2d 69  define address-i
01a0: 6e 70 72 6f 63 2d 31 20 22 69 6e 70 72 6f 63 3a  nproc-1 "inproc:
01b0: 2f 2f 6c 6f 63 61 6c 31 22 29 0a 28 64 65 66 69  //local1").(defi
01c0: 6e 65 20 61 64 64 72 65 73 73 2d 69 6e 70 72 6f  ne address-inpro
01d0: 63 2d 32 20 22 69 6e 70 72 6f 63 3a 2f 2f 6c 6f  c-2 "inproc://lo
01e0: 63 61 6c 32 22 29 0a 0a 3b 3b 3b 0a 3b 3b 3b 20  cal2")..;;;.;;; 
01f0: 52 65 71 2d 52 65 70 0a 3b 3b 3b 0a 28 64 65 66  Req-Rep.;;;.(def
0200: 69 6e 65 20 28 6d 61 6b 65 2d 6c 69 73 74 65 6e  ine (make-listen
0210: 69 6e 67 2d 72 65 70 6c 79 2d 73 6f 63 6b 65 74  ing-reply-socket
0220: 20 61 64 64 72 65 73 73 29 0a 20 20 28 6c 65 74   address).  (let
0230: 20 28 28 73 6f 63 6b 65 74 20 28 6d 61 6b 65 2d   ((socket (make-
0240: 72 65 70 2d 73 6f 63 6b 65 74 29 29 29 0a 20 20  rep-socket))).  
0250: 20 20 28 73 6f 63 6b 65 74 2d 73 65 74 21 20 73    (socket-set! s
0260: 6f 63 6b 65 74 20 27 6e 6e 67 2f 72 65 63 76 74  ocket 'nng/recvt
0270: 69 6d 65 6f 20 32 30 30 30 29 0a 20 20 20 20 28  imeo 2000).    (
0280: 6e 6e 67 2d 6c 69 73 74 65 6e 20 73 6f 63 6b 65  nng-listen socke
0290: 74 20 61 64 64 72 65 73 73 29 0a 20 20 20 20 73  t address).    s
02a0: 6f 63 6b 65 74 29 29 0a 0a 28 64 65 66 69 6e 65  ocket))..(define
02b0: 20 28 6d 61 6b 65 2d 64 69 61 6c 65 64 2d 72 65   (make-dialed-re
02c0: 71 75 65 73 74 2d 73 6f 63 6b 65 74 20 61 64 64  quest-socket add
02d0: 72 65 73 73 29 0a 20 20 28 6c 65 74 20 28 28 73  ress).  (let ((s
02e0: 6f 63 6b 65 74 20 28 6d 61 6b 65 2d 72 65 71 2d  ocket (make-req-
02f0: 73 6f 63 6b 65 74 29 29 29 0a 20 20 20 20 28 73  socket))).    (s
0300: 6f 63 6b 65 74 2d 73 65 74 21 20 73 6f 63 6b 65  ocket-set! socke
0310: 74 20 27 6e 6e 67 2f 72 65 63 76 74 69 6d 65 6f  t 'nng/recvtimeo
0320: 20 32 30 30 30 29 0a 20 20 20 20 28 6e 6e 67 2d   2000).    (nng-
0330: 64 69 61 6c 20 73 6f 63 6b 65 74 20 61 64 64 72  dial socket addr
0340: 65 73 73 29 0a 20 20 20 20 73 6f 63 6b 65 74 29  ess).    socket)
0350: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 65 71 2d  )..(define (req-
0360: 72 65 70 2d 74 65 73 74 20 61 64 64 72 65 73 73  rep-test address
0370: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 70 20 28  ).  (let ((rep (
0380: 6d 61 6b 65 2d 6c 69 73 74 65 6e 69 6e 67 2d 72  make-listening-r
0390: 65 70 6c 79 2d 73 6f 63 6b 65 74 20 61 64 64 72  eply-socket addr
03a0: 65 73 73 29 29 0a 20 20 20 20 20 20 20 20 28 72  ess)).        (r
03b0: 65 71 20 28 6d 61 6b 65 2d 64 69 61 6c 65 64 2d  eq (make-dialed-
03c0: 72 65 71 75 65 73 74 2d 73 6f 63 6b 65 74 20 61  request-socket a
03d0: 64 64 72 65 73 73 29 29 29 0a 20 20 20 20 28 6e  ddress))).    (n
03e0: 6e 67 2d 73 65 6e 64 20 72 65 71 20 22 6d 65 73  ng-send req "mes
03f0: 73 61 67 65 20 31 22 29 0a 20 20 20 20 28 6e 6e  sage 1").    (nn
0400: 67 2d 72 65 63 76 20 72 65 70 29 0a 20 20 20 20  g-recv rep).    
0410: 28 6e 6e 67 2d 73 65 6e 64 20 72 65 70 20 22 6d  (nng-send rep "m
0420: 65 73 73 61 67 65 22 29 0a 20 20 20 20 28 62 65  essage").    (be
0430: 67 69 6e 30 0a 20 20 20 20 20 28 6e 6e 67 2d 72  gin0.     (nng-r
0440: 65 63 76 20 72 65 71 29 0a 20 20 20 20 20 28 6e  ecv req).     (n
0450: 6e 67 2d 63 6c 6f 73 65 21 20 72 65 70 29 29 29  ng-close! rep)))
0460: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 6f 2d 74  )..(define (do-t
0470: 65 73 74 29 0a 20 20 28 74 65 73 74 2d 67 72 6f  est).  (test-gro
0480: 75 70 20 22 6e 6e 67 22 0a 20 20 20 20 20 20 20  up "nng".       
0490: 20 20 20 20 20 20 20 28 74 65 73 74 20 22 74 63         (test "tc
04a0: 70 20 72 65 71 2d 72 65 70 22 0a 20 20 20 20 20  p req-rep".     
04b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22                 "
04c0: 6d 65 73 73 61 67 65 22 0a 20 20 20 20 20 20 20  message".       
04d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65               (re
04e0: 71 2d 72 65 70 2d 74 65 73 74 20 61 64 64 72 65  q-rep-test addre
04f0: 73 73 2d 74 63 70 2d 31 29 29 0a 20 20 20 20 20  ss-tcp-1)).     
0500: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 20 22           (test "
0510: 69 6e 70 72 6f 63 20 72 65 71 2d 72 65 70 22 0a  inproc req-rep".
0520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0530: 20 20 20 20 22 6d 65 73 73 61 67 65 22 0a 20 20      "message".  
0540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0550: 20 20 28 72 65 71 2d 72 65 70 2d 74 65 73 74 20    (req-rep-test 
0560: 61 64 64 72 65 73 73 2d 69 6e 70 72 6f 63 2d 31  address-inproc-1
0570: 29 29 29 0a 20 20 28 74 65 73 74 2d 65 78 69 74  ))).  (test-exit
0580: 29 29 0a 0a 28 64 65 66 73 74 72 75 63 74 20 73  ))..(defstruct s
0590: 72 76 0a 20 20 6d 79 61 64 64 72 0a 20 20 72 65  rv.  myaddr.  re
05a0: 6d 61 64 64 72 0a 20 20 72 65 71 0a 20 20 72 65  maddr.  req.  re
05b0: 70 0a 20 20 6e 61 6d 65 29 0a 0a 28 64 65 66 69  p.  name)..(defi
05c0: 6e 65 20 28 73 65 72 76 65 72 2d 73 65 74 75 70  ne (server-setup
05d0: 20 6d 79 6e 61 6d 65 20 6d 79 61 64 64 72 20 72   myname myaddr r
05e0: 65 6d 6f 74 65 61 64 64 72 29 0a 20 20 28 6c 65  emoteaddr).  (le
05f0: 74 2a 20 28 28 73 72 76 64 61 74 20 28 6d 61 6b  t* ((srvdat (mak
0600: 65 2d 73 72 76 29 29 29 0a 20 20 20 20 28 73 72  e-srv))).    (sr
0610: 76 2d 6d 79 61 64 64 72 2d 73 65 74 21 20 73 72  v-myaddr-set! sr
0620: 76 64 61 74 20 6d 79 61 64 64 72 29 0a 20 20 20  vdat myaddr).   
0630: 20 28 73 72 76 2d 72 65 6d 61 64 64 72 2d 73 65   (srv-remaddr-se
0640: 74 21 20 73 72 76 64 61 74 20 72 65 6d 6f 74 65  t! srvdat remote
0650: 61 64 64 72 29 0a 20 20 20 20 28 73 72 76 2d 72  addr).    (srv-r
0660: 65 70 2d 73 65 74 21 20 73 72 76 64 61 74 20 28  ep-set! srvdat (
0670: 6d 61 6b 65 2d 6c 69 73 74 65 6e 69 6e 67 2d 72  make-listening-r
0680: 65 70 6c 79 2d 73 6f 63 6b 65 74 20 6d 79 61 64  eply-socket myad
0690: 64 72 29 29 0a 20 20 20 20 28 73 72 76 2d 72 65  dr)).    (srv-re
06a0: 71 2d 73 65 74 21 20 73 72 76 64 61 74 20 28 6d  q-set! srvdat (m
06b0: 61 6b 65 2d 64 69 61 6c 65 64 2d 72 65 71 75 65  ake-dialed-reque
06c0: 73 74 2d 73 6f 63 6b 65 74 20 6d 79 61 64 64 72  st-socket myaddr
06d0: 29 29 0a 20 20 20 20 28 73 72 76 2d 6e 61 6d 65  )).    (srv-name
06e0: 2d 73 65 74 21 20 73 72 76 64 61 74 20 6d 79 6e  -set! srvdat myn
06f0: 61 6d 65 29 0a 20 20 20 20 73 72 76 64 61 74 29  ame).    srvdat)
0700: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 6e 64  )..(define (send
0710: 2d 6e 2d 6d 65 73 73 61 67 65 73 20 6e 20 73 72  -n-messages n sr
0720: 76 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28  vdat).  (let* ((
0730: 6e 61 6d 65 20 28 73 72 76 2d 6e 61 6d 65 20 73  name (srv-name s
0740: 72 76 64 61 74 29 29 29 0a 20 20 20 20 28 6c 65  rvdat))).    (le
0750: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20  t loop ((i 0)). 
0760: 20 20 20 20 20 28 69 66 20 28 3c 20 69 20 6e 29       (if (< i n)
0770: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20  ..  (begin..    
0780: 28 70 72 69 6e 74 20 22 73 65 6e 64 3a 20 22 28  (print "send: "(
0790: 6e 6e 67 2d 73 65 6e 64 20 28 73 72 76 2d 72 65  nng-send (srv-re
07a0: 71 20 73 72 76 64 61 74 29 20 28 63 6f 6e 63 20  q srvdat) (conc 
07b0: 6e 61 6d 65 20 22 2d 22 20 69 29 29 29 0a 09 20  name "-" i))).. 
07c0: 20 20 20 28 70 72 69 6e 74 20 22 72 65 63 65 69     (print "recei
07d0: 76 65 3a 20 22 28 6e 6e 67 2d 72 65 63 76 20 28  ve: "(nng-recv (
07e0: 73 72 76 2d 72 65 70 20 73 72 76 64 61 74 29 29  srv-rep srvdat))
07f0: 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20  )..    (loop (+ 
0800: 69 20 31 29 29 29 29 29 29 29 0a 0a 28 64 65 66  i 1)))))))..(def
0810: 69 6e 65 20 28 63 6c 6f 73 65 2d 73 72 76 20 73  ine (close-srv s
0820: 72 76 64 61 74 29 0a 20 20 28 6e 6e 67 2d 63 6c  rvdat).  (nng-cl
0830: 6f 73 65 21 20 28 73 72 76 2d 72 65 70 20 73 72  ose! (srv-rep sr
0840: 76 64 61 74 29 29 29 0a 20 20 20 20 0a 28 6d 61  vdat))).    .(ma
0850: 74 63 68 0a 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69  tch. (command-li
0860: 6e 65 2d 61 72 67 75 6d 65 6e 74 73 29 0a 20 28  ne-arguments). (
0870: 28 22 64 6f 2d 74 65 73 74 22 29 28 64 6f 2d 74  ("do-test")(do-t
0880: 65 73 74 29 29 0a 20 28 28 22 73 65 6e 64 2d 6e  est)). (("send-n
0890: 22 20 6e 20 6d 79 61 64 64 72 20 74 6f 61 64 64  " n myaddr toadd
08a0: 72 29 0a 20 20 28 6c 65 74 20 28 28 6e 2d 6e 75  r).  (let ((n-nu
08b0: 6d 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65  m (string->numbe
08c0: 72 20 6e 29 29 0a 09 28 73 64 61 74 20 20 28 73  r n))..(sdat  (s
08d0: 65 72 76 65 72 2d 73 65 74 75 70 20 22 6a 75 73  erver-setup "jus
08e0: 74 20 74 65 73 74 69 6e 67 22 20 6d 79 61 64 64  t testing" myadd
08f0: 72 20 74 6f 61 64 64 72 29 29 29 0a 20 20 20 20  r toaddr))).    
0900: 28 73 65 6e 64 2d 6e 2d 6d 65 73 73 61 67 65 73  (send-n-messages
0910: 20 6e 2d 6e 75 6d 20 73 64 61 74 29 0a 20 20 20   n-num sdat).   
0920: 20 28 63 6c 6f 73 65 2d 73 72 76 20 73 64 61 74   (close-srv sdat
0930: 29 29 29 0a 20 28 28 63 6d 64 29 28 70 72 69 6e  ))). ((cmd)(prin
0940: 74 20 22 45 52 52 4f 52 3a 20 63 6f 6d 6d 61 6e  t "ERROR: comman
0950: 64 20 22 63 6d 64 22 2c 20 6e 6f 74 20 72 65 63  d "cmd", not rec
0960: 6f 67 6e 69 73 65 64 2e 5c 6e 5c 6e 22 68 65 6c  ognised.\n\n"hel
0970: 70 29 29 0a 20 28 65 6c 73 65 0a 20 20 28 70 72  p)). (else.  (pr
0980: 69 6e 74 20 68 65 6c 70 29 29 29 0a 0a           int help)))..