72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(set! res (cons (list->vector (cons a r)) res)))
db
(conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";")
runnamepatt)
(vector header res)))
(define (register-test db run-id test-name item-path)
(sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path) VALUES (?,?,strftime('%s','now'),?);" run-id test-name item-path))
(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 (null? comment))
(car comment))
(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
(car comment) run-id test-name item-path))))
(define (test-set-log! db run-id test-name itemdat logf)
(let ((item-path (item-list->path itemdat)))
(sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;"
logf run-id test-name item-path)))
;; ;; TODO: Converge this with db:get-test-info
;; (define (runs:get-test-info db run-id test-name item-path)
;; (let ((res #f)) ;; (vector #f #f #f #f #f #f)))
;; (sqlite3:for-each-row
;; (lambda (id run-id test-name state status)
;; (set! res (vector id run-id test-name state status item-path)))
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
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
122
123
124
125
126
127
128
129
130
131
|
(set! res (cons (list->vector (cons a r)) res)))
db
(conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";")
runnamepatt)
(vector header res)))
(define (register-test db run-id test-name item-path)
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(for-each
(lambda (pth)
(sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path) VALUES (?,?,strftime('%s','now'),?);" run-id test-name pth))
item-paths)))
;; (define db (open-db))
;; (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer")
(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 "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')
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
WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name)))
(if (and (not (null? comment))
(car comment))
(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
(car comment) run-id test-name item-path))))
(define (test-set-log! db run-id test-name itemdat logf)
(let ((item-path (item-list->path itemdat)))
(sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;"
logf run-id test-name item-path)))
(define (test-set-toplog! db run-id test-name logf)
(sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';"
logf run-id test-name))
;; ;; TODO: Converge this with db:get-test-info
;; (define (runs:get-test-info db run-id test-name item-path)
;; (let ((res #f)) ;; (vector #f #f #f #f #f #f)))
;; (sqlite3:for-each-row
;; (lambda (id run-id test-name state status)
;; (set! res (vector id run-id test-name state status item-path)))
|