Megatest

;;
(define (db:get-count-test-items-running db run-id testname)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND testname=? AND item_path !='';"
     run-id testname)
    res))

;; For an itemized test get the count of items matching status
(define (db:get-count-test-items-matching-status db run-id testname status)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM tests WHERE status=? AND run_id=? AND testname=? AND item_path !='';"
     status run-id testname)
    res))

(define (db:get-running-stats db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (state count)
       (set! res (cons (list state count) res)))

(define (cdb:test-set-status-state serverdat test-id status state msg)
  (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
      (cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
  (if msg
      (cdb:client-call serverdat 'state-status-msg #t *default-numtries* state status msg test-id)
      (cdb:client-call serverdat 'state-status #t *default-numtries* state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 

(define (cdb:test-set-state-status-by-name serverdat state status run-id testname item-path)
  (cdb:client-call serverdat 'state-status-by-name #t *default-numtries* state status run-id testname item-path))

(define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
  (cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))

(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
  (cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))

(define db:queries 
  (list '(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
	;; Test state and status
	'(set-test-state         "UPDATE tests SET state=?   WHERE id=?;")
	'(set-test-status        "UPDATE tests SET state=?   WHERE id=?;")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;")
	'(state-status-by-name   "UPDATE tests SET state=?,status=? WHERE run_id=? AND testname=? AND item_path=?;")
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
	;; Test comment
	'(set-test-comment       "UPDATE tests SET comment=? WHERE id=?;")
	'(set-test-start-time    "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;")
	'(pass-fail-counts       "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")

	;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps

(define (db:test-get-id-state-status-pass-fail-count db testname item-path)
  (let ((res #f))
    ;; First get the pass count
    (sqlite3:for-each-row
     (lambda (id state status pcount fcount)
       ;;          0   1      2      3     4      5
       (set! res (vector id state status pcount fcount)))
     db
     "SELECT id,state,status,pass_count,fail_count FROM tests WHERE testname=? AND item_path=?;" 
     testname item-path)
    res))

(define (db:test-get-testname-item_patt-state-status-pass-fail-count db test-id)
  (let ((res #f))
    ;; First get the pass count
    (sqlite3:for-each-row
     (lambda (testname item-path state status pcount fcount)
       (set! res (vector testname item-path vector state status pcount fcount)))
     db
     "SELECT testname,item_path,state,status,pass_count,fail_count FROM tests WHERE id=?;" 
     test-id)
    res))

;; This is NON-ACID compliant, does it matter?
;;

(define (mt:roll-up-pass-fail-counts run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (begin
	(cdb:update-pass-fail-counts *runremote* run-id test-name)
	(if (equal? status "RUNNING")
	    ;; This test is RUNNING, if the top test is not set to RUNNING then set it to RUNNING
	    (let ((state-status (cdb:remote-run db:test-get-state-status #f run-id test-name "")))
	      (if (not (equal? (vector-ref state-status 1) "RUNNING"))
		  (cdb:top-test-set-running *runremote* run-id test-name)))
	    ;; This following is a "big" query. Replace it with the multi-step sequence
	    ;; The fact that the replacement is not ACID may be a concern.
	    ;; (cdb:top-test-set-per-pf-counts *runremote* run-id test-name))
	    (let* ((num-running       0)
		   (num-items-running (cdb:remote-run db:get-count-test-items-running #f run-id test-name))
		   (num-items-skip    (cdb:remote-run db:get-count-test-items-matching-status #f run-id test-name "SKIP"))
		   (new-state         (if (> num-items-running 0) "RUNNING" "COMPLETED"))
		   (testinfo          (cdb:remote-run db:test-get-id-state-status-pass-fail-count #f test-name ""))
		   (curr-state        (vector-ref testinfo 1))
		   (curr-status       (vector-ref testinfo 2))
		   (pcount            (vector-ref testinfo 3))
		   (fcount            (vector-ref testinfo 4))
		   (new-status        #f))
	      (set! new-status
		    (cond
		     ((> fcount 0)         "FAIL")
		     ((> num-items-skip 0) "SKIP")
		     ((> pcount 0)         "PASS")))
	      (if (or (not (equal? curr-state new-state))
		      (not (equal? curr-status new-status)))
		  (cdb:test-set-state-status-by-name *runremote* new-state new-status run-id test-name "")))))
	#f)
      #f)

;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id test-id newstate newstatus newcomment)
  (cond
   ((and newstate newstatus newcomment)