170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
(let* ((real-status status)
(item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
(otherdat (if dat dat (make-hash-table)))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
;; was WAIVED if this test is FAIL
(waived (if (equal? status "FAIL")
(let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path)))
(if prev-test ;; true if we found a previous test in this run series
(let ((prev-status (db:test-get-status prev-test))
|
>
>
|
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
(let* ((real-status status)
(item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
(testdat (db:get-test-info db run-id test-name item-path))
(test-id (if testdat (db:test-get-id testdat) #f))
(otherdat (if dat dat (make-hash-table)))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
;; was WAIVED if this test is FAIL
(waived (if (equal? status "FAIL")
(let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path)))
(if prev-test ;; true if we found a previous test in this run series
(let ((prev-status (db:test-get-status prev-test))
|
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
(if waived (set! real-status "WAIVED"))
(debug:print 4 "real-status " real-status ", waived " waived ", status " status)
;; update the primary record IF state AND status are defined
(if (and state status)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state real-status run-id test-name item-path))
;; add metadata (need to do this way to avoid SQL injection issues)
;; :value
(let ((val (hash-table-ref/default otherdat ":value" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
;; :expected_value
(let ((val (hash-table-ref/default otherdat ":expected_value" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET expected_value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
;; :tol
(let ((val (hash-table-ref/default otherdat ":tol" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET tol=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
(let ((val (hash-table-ref/default otherdat ":units" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET units=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
;; :tol_perc
(let ((val (hash-table-ref/default otherdat ":tol_perc" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
|
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
>
<
<
<
<
<
<
<
|
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
(if waived (set! real-status "WAIVED"))
(debug:print 4 "real-status " real-status ", waived " waived ", status " status)
;; update the primary record IF state AND status are defined
(if (and state status)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state real-status run-id test-name item-path))
;; if status is "AUTO" then call rollup
(if (and test-id state status (equal? status "AUTO"))
(db:test-data-rollup db test-id))
;; add metadata (need to do this way to avoid SQL injection issues)
;; :first_err
(let ((val (hash-table-ref/default otherdat ":first_err" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
;; :first_warn
(let ((val (hash-table-ref/default otherdat ":first_warn" #f)))
(if val
(sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
;; need to update the top test record if PASS or FAIL and this is a subtest
(if (and (not (equal? item-path ""))
(or (equal? status "PASS")
(equal? status "WARN")
(equal? status "FAIL")
(equal? status "WAIVED")
|