1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
|
(min-incompleted-ids (map car incompleted)) ;; do 'em all
(all-ids (append min-incompleted-ids (map car oldlaunched))))
(if (> (length all-ids) 0)
(begin
(debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
(for-each
(lambda (test-id)
(db:test-set-status-state dbstruct run-id test-id "COMPLETE" "DEAD" "Test failed to complete"))
all-ids))))))
;; ALL REPLACED BY THE BLOCK ABOVE
;;
;; (sqlite3:execute
;; db
;; (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN ("
|
|
|
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
|
(min-incompleted-ids (map car incompleted)) ;; do 'em all
(all-ids (append min-incompleted-ids (map car oldlaunched))))
(if (> (length all-ids) 0)
(begin
(debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
(for-each
(lambda (test-id)
(db:test-set-state-status dbstruct run-id test-id "COMPLETE" "DEAD" "Test failed to complete"))
all-ids))))))
;; ALL REPLACED BY THE BLOCK ABOVE
;;
;; (sqlite3:execute
;; db
;; (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN ("
|
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
|
(debug:print-error 0 *default-log-port* "reception failed. Received \"" msg "\" but cannot translate it.")
(print-call-chain (current-error-port))
msg))) ;; crude reply for when things go awry
((zmq nmsg)(with-input-from-string msg (lambda ()(deserialize))))
(else msg))) ;; rpc
;; This is to be the big daddy call
(define (db:test-set-status-state dbstruct run-id test-id status state msg)
(let ((dbdat (db:get-db dbstruct run-id)))
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(db:general-call dbdat 'set-test-start-time (list test-id)))
;; (if msg
;; (db:general-call dbdat 'state-status-msg (list state status msg test-id))
;; (db:general-call dbdat 'state-status (list state status test-id)))
(db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
|
|
|
|
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
|
(debug:print-error 0 *default-log-port* "reception failed. Received \"" msg "\" but cannot translate it.")
(print-call-chain (current-error-port))
msg))) ;; crude reply for when things go awry
((zmq nmsg)(with-input-from-string msg (lambda ()(deserialize))))
(else msg))) ;; rpc
;; This is to be the big daddy call
;;
(define (db:test-set-state-status dbstruct run-id test-id state status msg)
(let ((dbdat (db:get-db dbstruct run-id)))
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(db:general-call dbdat 'set-test-start-time (list test-id)))
;; (if msg
;; (db:general-call dbdat 'state-status-msg (list state status msg test-id))
;; (db:general-call dbdat 'state-status (list state status test-id)))
(db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
|