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
|
(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
rmtmod)
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
|
>
|
>
|
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
301
302
303
304
305
306
307
308
309
310
311
312
313
314
|
(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* ((testdat (if (number? test-name)
(rmt:get-test-info-by-id run-id test-name) ;; test-name is actually a test-id
(db:keep-trying-until-true ;; in our threaded stuff this call could happen before the test is registered (maybe?)
rmt:get-test-info
(list run-id test-name item-path)
10)))
(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)
|
|
|
|
|
|
>
>
|
|
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
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)
)))))
|
<
<
<
<
|
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))
|