89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
+
-
+
|
(define (test-set-status! db run-id test-name state status itemdat-or-path . comment)
(let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))))
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state status run-id test-name item-path)
(if (and (not (equal? item-path "")) ;; need to update the top test record if PASS or FAIL and this is a subtest
(or (equal? status "PASS")
(equal? status "WARN")
(equal? status "FAIL")))
(begin
(sqlite3:execute
db
"UPDATE tests
SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='PASS')
pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN'))
WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name run-id test-name run-id test-name)
(sqlite3:execute
db
"UPDATE tests
SET state='COMPLETED',
status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
|
338
339
340
341
342
343
344
345
346
347
348
349
350
351
|
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
|
+
|
(string->symbol (test:get-state test-status))
'failed-to-insert))
((failed-to-insert)
(print "ERROR: Failed to insert the record into the db"))
((NOT_STARTED COMPLETED) ;; (cadr status is the row id for the run record)
(if (and (equal? (test:get-state test-status) "COMPLETED")
(or (equal? (test:get-status test-status) "PASS")
(equal? (test:get-status test-status) "WARN")
(equal? (test:get-status test-status) "CHECK"))
(not (args:get-arg "-force")))
(print "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status test-status) "\", use -force to override")
(let* ((get-prereqs-cmd (lambda ()
(db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
(launch-cmd (lambda ()
(launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
|