353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
|
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
(define (db-get-tests-for-run db run-id testpatt itempatt states statuses)
(let ((res '())
(states-str (if (and states (not (null? states)))
(conc " AND state NOT IN ('" (string-intersperse states "','") "')") ""))
(statuses-str (if (and statuses (not (null? statuses)))
(conc " AND status NOT IN ('" (string-intersperse statuses "','") "')") "")))
" FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? "
states-str statuses-str
" ORDER BY id DESC;")
run-id
(if testpatt testpatt "%")
(if itempatt itempatt "%"))
res))
;; this one is a bit broken BUG FIXME
|
>
<
|
<
|
>
|
|
|
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
|
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
(define (db-get-tests-for-run db run-id testpatt itempatt states statuses)
(let ((res '())
(states-str (conc "('" (string-intersperse states "','") "')"))
(statuses-str (conc "('" (string-intersperse statuses "','") "')"))
)
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn)
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn) res)))
db
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn "
" FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? "
" AND NOT (state in " states-str " AND status IN " statuses-str ") "
" ORDER BY id DESC;")
run-id
(if testpatt testpatt "%")
(if itempatt itempatt "%"))
res))
;; this one is a bit broken BUG FIXME
|
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
|
;;
;; Return a list of prereqs that were NOT met
;; Tests (and all items) in waiton list must be "COMPLETED" and "PASS"
(define (db-get-prereqs-not-met db run-id waiton)
(if (null? waiton)
'()
(let* ((unmet-pre-reqs '())
(tests (db-get-tests-for-run db run-id #f #f))
(result '()))
(for-each (lambda (waitontest-name)
(let ((ever-seen #f))
(for-each (lambda (test)
(if (equal? waitontest-name (db:test-get-testname test))
(begin
(set! ever-seen #t)
|
|
|
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
|
;;
;; Return a list of prereqs that were NOT met
;; Tests (and all items) in waiton list must be "COMPLETED" and "PASS"
(define (db-get-prereqs-not-met db run-id waiton)
(if (null? waiton)
'()
(let* ((unmet-pre-reqs '())
(tests (db-get-tests-for-run db run-id #f #f '() '()))
(result '()))
(for-each (lambda (waitontest-name)
(let ((ever-seen #f))
(for-each (lambda (test)
(if (equal? waitontest-name (db:test-get-testname test))
(begin
(set! ever-seen #t)
|