Overview
| Comment: | fixed logic in test registration. More agressive starting of a server when sync takes a long time |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
333191162a91c70dc3731cb977e73242 |
| User & Date: | matt on 2014-11-16 21:50:06 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-11-16
| ||
| 21:58 | Tweaks for testing check-in: afb9cc1df1 user: mrwellan tags: v1.60 | |
| 21:50 | fixed logic in test registration. More agressive starting of a server when sync takes a long time check-in: 333191162a user: matt tags: v1.60 | |
| 20:51 | missed a variable change in a almost never used routine - only to trigger the use of said routine. check-in: 4cfc6e3ba2 user: matt tags: v1.60 | |
Changes
Modified megatest.scm from [3ecca6725e] to [521d8a79fe].
| ︙ | ︙ | |||
300 301 302 303 304 305 306 | (if (hash-table-ref/default *db-local-sync* run-id #f) ;; (if (> (- start-time last-write) 5) ;; every five seconds (let ((sync-time (- (current-seconds) start-time))) (db:multi-db-sync (list run-id) 'new2old) (if (common:low-noise-print 30 "sync new to old") (begin (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds") | | < | < | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 |
(if (hash-table-ref/default *db-local-sync* run-id #f)
;; (if (> (- start-time last-write) 5) ;; every five seconds
(let ((sync-time (- (current-seconds) start-time)))
(db:multi-db-sync (list run-id) 'new2old)
(if (common:low-noise-print 30 "sync new to old")
(begin
(debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
(if (> sync-time 10) ;; took more than ten seconds, start a server for this run
(begin
(debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id)
(server:kind-run run-id)))))
(hash-table-delete! *db-local-sync* run-id)))
(mutex-unlock! *db-multi-sync-mutex*))
(hash-table-keys *db-local-sync*)))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
|
| ︙ | ︙ |
Modified runs.scm from [94d1fbb17e] to [e885f5dfc6].
| ︙ | ︙ | |||
670 671 672 673 674 675 676 677 |
;; Register tests
;;
((not (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f))
(debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs
(rmt:general-call 'register-test run-id run-id test-name item-path)
(if (not (eq? (hash-table-ref/default test-registry (runs:make-full-test-name test-name "") #f) 'done))
| > > | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 |
;; Register tests
;;
((not (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f))
(debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs
(rmt:general-call 'register-test run-id run-id test-name item-path)
(hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'done)
(if (not (eq? (hash-table-ref/default test-registry (runs:make-full-test-name test-name "") #f) 'done))
(begin
(rmt:general-call 'register-test run-id run-id test-name "")
(hash-table-set! test-registry (runs:make-full-test-name test-name "") 'done)))
(runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?)
(if (and (null? tal)(null? reg))
(list hed tal (append reg (list hed)) reruns)
(list (runs:queue-next-hed tal reg reglen regfull)
(runs:queue-next-tal tal reg reglen regfull)
;; NB// Here we are building reg as we register tests
;; if regfull we must pop the front item off reg
|
| ︙ | ︙ |
Modified server.scm from [13f9300039] to [f2b9d5f3d9].
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
(pop-directory)))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
(define (server:kind-run run-id)
(let ((last-run-time (hash-table-ref/default *server-kind-run* run-id #f)))
(if (or (not last-run-time)
| | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 |
(pop-directory)))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
(define (server:kind-run run-id)
(let ((last-run-time (hash-table-ref/default *server-kind-run* run-id #f)))
(if (or (not last-run-time)
(> (- (current-seconds) last-run-time) 30))
(begin
(server:run run-id)
(hash-table-set! *server-kind-run* run-id (current-seconds))))))
;; The generic run a server command. Dispatches the call to server 0 if run-id != 0
;;
(define (server:try-running run-id)
|
| ︙ | ︙ |