Megatest

Diff
Login

Differences From Artifact [a8d45b3634]:

To Artifact [41c48e20a6]:


428
429
430
431
432
433
434

435

436
437
438
439
440
441

442
443
444
445
446
447
448
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)
(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 NOT (state in " states-str " AND status IN " statuses-str ") "
			 " 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
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)
(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))
      (db:get-tests-for-run db run-id testpatt itempatt states statuses)))
	  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))