906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
run-id
)
(debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
(define (db:get-tests-for-runs-mindata db run-ids testpatt states status)
(db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; NB // This is get tests for "runs" (note the plural!!)
;;
;; 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
;; not-in #t = above behaviour, #f = must match
;; run-ids is a list of run-ids or a single number
(define (db:get-tests-for-runs db run-ids testpatt states statuses
#!key (not-in #t)
(sort-by #f)
(qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time
(debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
(let* ((res '())
;; if states or statuses are null then assume match all when not-in is false
|
|
|
|
|
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
run-id
)
(debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
(define (db:get-tests-for-runs-mindata db run-ids testpatt states status not-in)
(db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; NB // This is get tests for "runs" (note the plural!!)
;;
;; 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
;; not-in #t = above behaviour, #f = must match
;; run-ids is a list of run-ids or a single number or #f for all runs
(define (db:get-tests-for-runs db run-ids testpatt states statuses
#!key (not-in #t)
(sort-by #f)
(qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time
(debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
(let* ((res '())
;; if states or statuses are null then assume match all when not-in is false
|
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
(conc " status "
(if not-in "NOT" "")
" IN ('"
(string-intersperse statuses "','")
"')")))
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT " qryvals
" FROM tests WHERE state != 'DELETED' AND "
(if run-ids
(if (list? run-ids)
(conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ")
(conc "run_id=" run-ids " "))
" ") ;; #f => run-ids don't filter on run-ids
(if states-qry (conc " AND " states-qry) "")
(if statuses-qry (conc " AND " statuses-qry) "")
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
(case sort-by
((rundir) " ORDER BY length(rundir) DESC;")
((event_time) " ORDER BY event_time ASC;")
|
|
|
|
|
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
(conc " status "
(if not-in "NOT" "")
" IN ('"
(string-intersperse statuses "','")
"')")))
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT " qryvals
" FROM tests WHERE state != 'DELETED' "
(if run-ids
(if (list? run-ids)
(conc "AND run_id IN (" (string-intersperse (map conc run-ids) ",") ") ")
(conc "AND run_id=" run-ids " "))
" ") ;; #f => run-ids don't filter on run-ids
(if states-qry (conc " AND " states-qry) "")
(if statuses-qry (conc " AND " statuses-qry) "")
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
(case sort-by
((rundir) " ORDER BY length(rundir) DESC;")
((event_time) " ORDER BY event_time ASC;")
|
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
|
(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
(cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
;; speed up for common cases with a little logic
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(sqlite3:exectute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(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)))))
|
|
|
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
|
(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
(cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
;; speed up for common cases with a little logic
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(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)))))
|
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
|
(for-each
(lambda (test)
;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test))
(is-completed (equal? state "COMPLETED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
(same-itempath (equal? ref-item-path item-path)))
(set! ever-seen #t)
(cond
;; case 1, non-item (parent test) is
((and (equal? item-path "") ;; this is the parent test
is-completed
(or is-ok (member mode '(toplevel itemmatch))))
(set! parent-waiton-met #t))
((or (and (not same-itempath)
(eq? mode 'itemmatch)) ;; in itemmatch mode we look only at the same itempath
(and same-itempath
is-completed
(or is-ok
(eq? mode 'toplevel) ;; toplevel does not block on FAIL
|
>
>
>
>
>
>
|
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
|
(for-each
(lambda (test)
;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test))
(is-completed (equal? state "COMPLETED"))
(is-killed (equal? state "KILLED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
(same-itempath (equal? ref-item-path item-path)))
(set! ever-seen #t)
(cond
;; case 1, non-item (parent test) is
((and (equal? item-path "") ;; this is the parent test
is-completed
(or is-ok (member mode '(toplevel itemmatch))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
((and (equal? item-path "") ;; this is the parent test
is-killed
(eq? mode 'toplevel))
(set! parent-waiton-met #t))
((or (and (not same-itempath)
(eq? mode 'itemmatch)) ;; in itemmatch mode we look only at the same itempath
(and same-itempath
is-completed
(or is-ok
(eq? mode 'toplevel) ;; toplevel does not block on FAIL
|