Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-servload |
Files: | files | file ages | folders |
SHA1: |
4c125c180a69b595ea74b4f9a67e43df |
User & Date: | matt on 2023-04-18 20:52:58 |
Other Links: | branch diff | manifest | tags |
Context
2023-04-19
| ||
09:58 | wip, clean up check-in: 996c305353 user: matt tags: v1.80-servload | |
2023-04-18
| ||
20:52 | wip check-in: 4c125c180a user: matt tags: v1.80-servload | |
08:31 | Start of moving rollup off the server check-in: 95c5f92eb5 user: matt tags: v1.80-servload | |
Changes
Modified db.scm from [e4a21bbcbc] to [0a63eb3ca2].
︙ | ︙ | |||
2671 2672 2673 2674 2675 2676 2677 | ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 (set! res (cons (apply vector a b) res))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in (" (string-intersperse (map conc test-ids) ",") ");")) res)))) | < < < < < < < < < < < < < < < | 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 | ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 (set! res (cons (apply vector a b) res))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in (" (string-intersperse (map conc test-ids) ",") ");")) res)))) (define (db:get-test-info dbstruct run-id test-name item-path) (let* ((test-id (db:get-test-id dbstruct run-id test-name item-path))) (db:get-test-info-by-id dbstruct run-id test-id))) ;; (db:with-db ;; dbstruct ;; run-id ;; #f |
︙ | ︙ |
Modified dbmod.scm from [b9113d296b] to [840556f4fb].
︙ | ︙ | |||
153 154 155 156 157 158 159 160 161 162 163 164 165 166 | (lambda () (let* ((db (sqlite3:open-database dbfullname)) (handler (sqlite3:make-busy-timeout 136000))) (sqlite3:set-busy-handler! db handler) (if write-access (init-proc db)) db)))) (define *sync-in-progress* #f) ;; Open the inmem db and the on-disk db ;; populate the inmem db with data ;; ;; Updates fields in dbstruct | > > > > > > > > > > > > > > > > | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | (lambda () (let* ((db (sqlite3:open-database dbfullname)) (handler (sqlite3:make-busy-timeout 136000))) (sqlite3:set-busy-handler! db handler) (if write-access (init-proc db)) db)))) ;; try every second until tries times proc ;; (define (db:keep-trying-until-true proc params tries) (let* ((res (apply proc params))) (if res res (if (> tries 0) (begin (thread-sleep! 1) (db:keep-trying-until-true proc params (- tries 1))) (begin ;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params) (print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries) #f))))) (define *sync-in-progress* #f) ;; Open the inmem db and the on-disk db ;; populate the inmem db with data ;; ;; Updates fields in dbstruct |
︙ | ︙ |
Modified mt.scm from [5d7251e2a1] to [09dd853b7e].
︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables) (import (prefix sqlite3 sqlite3:)) (declare (unit mt)) (declare (uses debugprint)) (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses runs)) (declare (uses rmt)) (declare (uses rmtmod)) (import debugprint | > | > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables) (import (prefix sqlite3 sqlite3:)) (declare (unit mt)) (declare (uses debugprint)) (declare (uses db)) (declare (uses dbmod)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses runs)) (declare (uses rmt)) (declare (uses rmtmod)) (import debugprint rmtmod dbmod) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | ︙ | |||
294 295 296 297 298 299 300 | (rmt:client-side-set-state-status-and-roll-up run-id test-name item-path state status comment) ;; (rmtmod:send-receive 'set-state-status-and-roll-up-items run-id (list run-id test-name item-path state status comment)) ) (define (rmt:client-side-set-state-status-and-roll-up run-id test-name item-path state status comment) ;; establish info on incoming test followed by info on top level test ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met | | | | | | > > | | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | (rmt:client-side-set-state-status-and-roll-up run-id test-name item-path state status comment) ;; (rmtmod:send-receive 'set-state-status-and-roll-up-items run-id (list run-id test-name item-path state status comment)) ) (define (rmt:client-side-set-state-status-and-roll-up run-id test-name item-path state status comment) ;; establish info on incoming test followed by info on top level test ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met (let* ((test-id (if (number? test-name) test-name (db:keep-trying-until-true rmt:get-test-id (list run-id test-name item-path) 10))) ;; (rmt:get-test-id run-id test-name item-path))) (testdat (rmt:get-test-info-by-id run-id test-id)) ;; (test-id (db:test-get-id testdat)) (test-name (if (number? test-name) (db:test-get-testname testdat) test-name)) (item-path (db:test-get-item-path testdat)) (tl-testdat (rmt:get-test-info run-id test-name "")) (tl-test-id (if tl-testdat (db:test-get-id tl-testdat) |
︙ | ︙ | |||
413 414 415 416 417 418 419 | (rmt:set-state-status-and-roll-up-items run-id test-id 'foo "COMPLETED" "DEAD" "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead."))))))) ;; call end of eud of run detection for posthook - from merge, is it needed? ;; (launch:end-of-run-check run-id) all-ids) ))))) | < < < < | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | (rmt:set-state-status-and-roll-up-items run-id test-id 'foo "COMPLETED" "DEAD" "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead."))))))) ;; call end of eud of run detection for posthook - from merge, is it needed? ;; (launch:end-of-run-check run-id) all-ids) ))))) (define (mt:lazy-read-test-config test-name) (let ((tconf (hash-table-ref/default *testconfigs* test-name #f))) (if tconf tconf (let ((test-dirs (tests:get-tests-search-path *configdat*))) (let loop ((hed (car test-dirs)) |
︙ | ︙ |