428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
;;======================================================================
;; 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 "','") "')"))
(qry (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment "
" 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;"
" ORDER BY event_time ASC;" ;; POTENTIAL ISSUE! CHECK ME! Does anyting depend on this being sorted by id?
)))
(debug:print 8 "INFO: db:get-tests-for-run qry=" qry)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
|
>
|
|
|
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
;;======================================================================
;; 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
;; not-in #t = above behaviour, #f = must match
(define (db:get-tests-for-run db run-id testpatt itempatt states statuses #!key (not-in #t))
(let* ((res '())
(states-str (conc "('" (string-intersperse states "','") "')"))
(statuses-str (conc "('" (string-intersperse statuses "','") "')"))
(qry (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment "
" FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? "
" AND " (if not-in "NOT" "") " (state in " states-str " AND status IN " statuses-str ") "
;; " ORDER BY id DESC;"
" ORDER BY event_time ASC;" ;; POTENTIAL ISSUE! CHECK ME! Does anyting depend on this being sorted by id?
)))
(debug:print 8 "INFO: db:get-tests-for-run qry=" qry)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
|
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
|
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-runs host port)
runnamepatt numruns startrunoffset keypatts))
(db:get-runs db runnamepatt numruns startrunoffset keypatts)))
(define (rdb:get-tests-for-run db run-id testpatt itempatt states statuses)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-tests-for-run host port)
run-id testpatt itempatt states statuses))
(db:get-tests-for-run db run-id testpatt itempatt states statuses)))
(define (rdb:get-test-data-by-id db test-id)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rpc:get-test-data-by-id host port)
test-id))
|
|
|
|
|
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-runs host port)
runnamepatt numruns startrunoffset keypatts))
(db:get-runs db runnamepatt numruns startrunoffset keypatts)))
(define (rdb:get-tests-for-run db run-id testpatt itempatt states statuses #!key (not-in #t))
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-tests-for-run host port)
run-id testpatt itempatt states statuses not-in: not-in))
(db:get-tests-for-run db run-id testpatt itempatt states statuses not-in: not-in)))
(define (rdb:get-test-data-by-id db test-id)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rpc:get-test-data-by-id host port)
test-id))
|