Megatest

Check-in [723b985766]
Login
Overview
Comment:Add small delay on first call to wait-on-server before trying to start a server.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 723b9857661ca8b8191a46c1e867e2de35ba15bc
User & Date: matt on 2017-03-28 11:36:40
Other Links: branch diff | manifest | tags
Context
2017-03-28
13:06
Fixed call to runs:clear-cache with wrong arguments. Make tests:get-tests-search-path resistant to bad config data check-in: 619330088c user: matt tags: v1.64
11:36
Add small delay on first call to wait-on-server before trying to start a server. check-in: 723b985766 user: matt tags: v1.64
10:54
Force starting a server and wait for it when launching runs. This prevents server run-away but doesn't fix the underlying issue. check-in: 27b1636e7b user: matt tags: v1.64
Changes

Modified server.scm from [d6964e3100] to [32389a7830].

296
297
298
299
300
301
302
303


304
305
306
307

308

309
310
311


312
313
314
315
316
317
318
296
297
298
299
300
301
302

303
304
305
306
307
308
309

310
311
312

313
314
315
316
317
318
319
320
321







-
+
+




+
-
+


-
+
+







		  (server:run areapath)
		  (thread-sleep! 5) ;; don't release the lock for at least a few seconds
		  (common:simple-file-release-lock lock-file)))
	(hash-table-set! *server-kind-run* areapath (list (+ call-num 1)(current-seconds))))))

(define (server:start-and-wait areapath #!key (timeout 60))
  (let ((give-up-time (+ (current-seconds) timeout)))
    (let loop ((server-url (server:check-if-running areapath)))
    (let loop ((server-url (server:check-if-running areapath))
	       (try-num    0))
      (if (or server-url
	      (> (current-seconds) give-up-time)) ;; server-url will be #f if no server available.
	  server-url
	  (let ((num-ok (length (server:get-best (server:get-list areapath)))))
	    (if (and (> try-num 0)  ;; first time through simply wait a little while then try again
	    (if (< num-ok 1) ;; if there are no decent candidates for servers then try starting a new one
		     (< num-ok 1))  ;; if there are no decent candidates for servers then try starting a new one
		(server:kind-run areapath))
	    (thread-sleep! 5)
	    (loop (server:check-if-running areapath)))))))
	    (loop (server:check-if-running areapath)
		  (+ try-num 1)))))))

(define server:try-running server:run) ;; there is no more per-run servers ;; REMOVE ME. BUG.

(define (server:get-num-servers #!key (numservers 2))
  (let ((ns (string->number
	     (or (configf:lookup *configdat* "server" "numservers") "notanumber"))))
    (or ns numservers)))