226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
;; WARNING: SQL injection risk
(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
(for-each (lambda (testname)
(let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
(if currstate (conc "state='" currstate "' AND ") "")
(if currstatus (conc "status='" currstatus "' AND ") "")
" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;(print "QRY: " qry)
(sqlite3:execute db qry newstate newstatus testname testname)))
testnames))
;; "('" (string-intersperse tests "','") "')")
|
|
|
>
>
|
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
;; WARNING: SQL injection risk
(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
(for-each (lambda (testname)
(let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
(if currstate (conc "state='" currstate "' AND ") "")
(if currstatus (conc "status='" currstatus "' AND ") "")
" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;(debug:print 0 "QRY: " qry)
(sqlite3:execute db qry newstate newstatus testname testname)))
testnames))
(define (db:delete-tests-in-state db run-id state)
(sqlite3:execute db "DELETE FROM tests WHERE state=? AND run_id=?;" state run-id))
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))
(define (db:get-count-tests-running db)
|
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
;; ;; tests))
;; (completed-tests (let ((non-completed (make-hash-table)))
;; (for-each (lambda (x)
;; ;; could add check for PASS here
;; (if (not (and (equal? (db:test-get-state x) "COMPLETED")
;; (equal? (db:test-get-status x) "PASS")))
;; (hash-table-set! non-completed (db:test-get-testname x) x)))
;; ;; (print "Completed: " (db:test-get-testname x))))
;; tests)
;; (filter (lambda (x)
;; (not (hash-table-ref/default non-completed (db:test-get-testname x) #f)))
;; tests)))
;; (pre-dep-names (map db:test-get-testname completed-tests))
;; (result (lset-difference string=? waiton pre-dep-names)))
;; (print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result)
|
|
|
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
|
;; ;; tests))
;; (completed-tests (let ((non-completed (make-hash-table)))
;; (for-each (lambda (x)
;; ;; could add check for PASS here
;; (if (not (and (equal? (db:test-get-state x) "COMPLETED")
;; (equal? (db:test-get-status x) "PASS")))
;; (hash-table-set! non-completed (db:test-get-testname x) x)))
;; ;; (debug:print 0 "Completed: " (db:test-get-testname x))))
;; tests)
;; (filter (lambda (x)
;; (not (hash-table-ref/default non-completed (db:test-get-testname x) #f)))
;; tests)))
;; (pre-dep-names (map db:test-get-testname completed-tests))
;; (result (lset-difference string=? waiton pre-dep-names)))
;; (print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result)
|