Megatest

Check-in [7b5c5970ba]
Login
Overview
Comment:Added missing mockupclientlib file
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7b5c5970ba0574f25c26f04da735b6ce0c2c84dd
User & Date: matt on 2013-01-07 20:15:09
Other Links: manifest | tags
Context
2013-01-09
15:50
Missing runconfigs section. check-in: 977a37ad23 user: mrwellan tags: trunk
2013-01-08
11:07
Added/modified stuff for mockup check-in: ff1b962889 user: mrwellan tags: remote-run-capability
2013-01-07
20:15
Added missing mockupclientlib file check-in: 7b5c5970ba user: matt tags: trunk
2012-12-17
09:32
Moved tabs around in main gui. Changed configf.scm to not process #{} when not in allow-system mode check-in: 866c36fc2f user: mrwellan tags: trunk
Changes

Added testzmq/mockupclientlib.scm version [6a9bd9de5d].



































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(define sub  (make-socket 'sub))
(define push (make-socket 'push))
(socket-option-set! sub 'subscribe cname)
(connect-socket sub "tcp://localhost:5563")
(connect-socket push "tcp://localhost:5564")

(define (dbaccess cname cmd var val #!key (numtries 1))
  (let* ((msg (conc cname ":" cmd ":" (if val (conc var " " val) var)))
	 (res #f)
	 (do-access (lambda ()
		      (print "Sending msg: " msg)
		      (send-message push msg)
		      (print "Message " msg " sent")
		      (print "Client " cname " waiting for response to " msg)
		      (print "Client " cname " received address " (receive-message* sub))
		      (set! res (receive-message* sub)))))
    (let ((th1 (make-thread do-access "do access"))
	  (th2 (make-thread (lambda ()
			      (thread-sleep! 5)
			      (if (not res)
				  (if (> numtries 0)
				      (begin
					(print "WARNING: access timed out for " cname ", trying again. Trys remaining=" numtries)
					(dbaccess cname cmd var val numtries: (- numtries 1)))
				      (begin
					(print "ERROR: dbaccess timed out. Exiting")
					(exit)))))
			    "timeout thread")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th1)
      res)))