92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
-
+
-
-
+
+
|
(let ((valid-values (let ((s (config-lookup *configdat* "validvalues" class)))
(if s (string-split s) #f))))
(if valid-values
(if (member item valid-values)
item #f)
item)))
(define (teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat)
(define (teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat comment)
;; (print "run-id: " run-id " test-name: " test-name)
(let* ((state (check-valid-items "state" state-in))
(status (check-valid-items "status" status-in))
(item-path (item-list->path itemdat))
(testdat (runs:get-test-info db run-id test-name item-path)))
;; (print "testdat: " testdat)
(if (and testdat ;; if the section exists then force specification BUG, I don't like how this works.
(or (not state)(not status)))
(print "WARNING: Invalid " (if status "status" "state")
" value \"" (if status status-in state-in) "\", update your validstates section in megatest.config"))
(if testdat
(let ((test-id (test:get-id testdat)))
(sqlite3:execute db
"INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time) VALUES(?,?,?,?,strftime('%s','now'));"
test-id teststep-name state status))
"INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment) VALUES(?,?,?,?,strftime('%s','now'),?);"
test-id teststep-name state status (if comment comment "")))
(print "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))
(define (test-get-kill-request db run-id test-name itemdat)
(let* ((item-path (item-list->path itemdat))
(testdat (runs:get-test-info db run-id test-name item-path)))
(equal? (test:get-state testdat) "KILLREQ")))
|