Megatest

Diff
Login

Differences From Artifact [931afe1758]:

To Artifact [fda4c90157]:


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
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   (if (and states (not (null? states)))
			  (conc " AND state NOT IN ('" (string-intersperse states   "','") "')") ""))
	(states-str    (conc "('" (string-intersperse states   "','") "')"))
	(statuses-str (if (and statuses (not (null? statuses)))
			  (conc " AND status NOT IN ('" (string-intersperse statuses "','") "')") "")))
	(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 ? "
	   states-str statuses-str
	   " 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
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))
	     (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)