Megatest

Check-in [d69a3dee28]
Login
Overview
Comment:Added catching of ^c and flushing of server communication so that server doesn't die
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.5111
Files: files | file ages | folders
SHA1: d69a3dee281f7ccfef03dff6c75cf1a401d88059
User & Date: mrwellan on 2012-11-05 13:27:20
Other Links: manifest | tags
Context
2012-11-05
13:40
Slight improvement to catching of ^c and flushing of server communication. Servers still dies sometimes check-in: 9daa64433e user: mrwellan tags: trunk, v1.5112
13:27
Added catching of ^c and flushing of server communication so that server doesn't die check-in: d69a3dee28 user: mrwellan tags: trunk, v1.5111
13:20
Added catching of ^c and flushing of server communication so that server doesn't die check-in: bb324e0945 user: mrwellan tags: trunk, v1.5110
Changes

Modified common.scm from [fed65ad912] to [48dba0a8c5].

46
47
48
49
50
51
52

53
54
55
56
57
58
59
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60







+







(define *runremote*         #f) ;; if set up for server communication this will hold <host port>
(define *last-db-access*    (current-seconds))  ;; update when db is accessed via server
(define *max-cache-size*    0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id*         #f)
(define *time-to-exit* #f)
(define *received-response* #f)

(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys*              (make-hash-table)) ;; cache the keys here
(define *keyvals*           (make-hash-table))
(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id

Modified db.scm from [c960b481ca] to [fcdb272fed].

1181
1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1181
1182
1183
1184
1185
1186
1187

1188
1189
1190
1191
1192

1193
1194
1195
1196
1197
1198
1199
1200







-
+




-
+







    res))
  
;; params = 'target cached remparams
(define (cdb:client-call zmq-socket . params)
  (debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
  (let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
	(res  #f))
    ;; (signal-mask! signal/int)
    (set! *received-response* #f)
    (send-message zmq-socket zdat)
    (set! res (db:string->obj (if *client-non-blocking-mode* 
				  (receive-message* zmq-socket)
				  (receive-message  zmq-socket))))
    ;; (signal-unmask! signal/int)
    (set! *received-response* #t)
    (debug:print-info 11 "zmq-socket " (car params) " res=" res)
    res))
  
(define (cdb:set-verbosity zmq-socket val)
  (cdb:client-call zmq-socket 'set-verbosity #f val))

(define (cdb:login zmq-socket keyval signature)

Modified server.scm from [0c3e939ba0] to [65718bc009].

319
320
321
322
323
324
325

326

327
328
329
330
331
332
333
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334







+
-
+







    (exit)))

(define (server:client-signal-handler signum)
  (handle-exceptions
   exn
   (debug:print " ... exiting ...")
   (let ((th1 (make-thread (lambda ()
			     (if (not *received-response*)
			     (receive-message* *runremote*)) ;; flush out last call if applicable
				 (receive-message* *runremote*))) ;; flush out last call if applicable
			   "eat response"))
	 (th2 (make-thread (lambda ()
			     (debug:print 0 "ERROR: Received ^C, attempting clean exit.")
			     (thread-sleep! 3) ;; give the flush three seconds to do it's stuff
			     (debug:print 0 "       Done.")
			     (exit 4))
			   "exit on ^C timer")))