Megatest

(define *common:std-states*   
  '((0 "ARCHIVED")
    (1 "STUCK")
    (2 "KILLREQ")
    (3 "KILLED")
    (4 "NOT_STARTED")
    (5 "RUNNING")
    (5 "COMPLETED")
    (6 "LAUNCHED")
    (7 "REMOTEHOSTSTART")
    (8 "COMPLETED")
    (8 "RUNNING")
    ))

(define *common:std-statuses*
  '(;; (0 "DELETED")
    (1 "n/a")
    (2 "PASS")
    (3 "CHECK")
    (4 "SKIP")
    (5 "WARN")
    (6 "WAIVED")
    (7 "STUCK/DEAD")
    (8 "FAIL")
    (9 "ABORT")))

(define *common:ended-states* ;; states which indicate the test is stopped and will not proceed
  '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE"))

(define (common:special-sort items order comp)
  (let ((items-order (map reverse order))
        (acomp       (or comp >)))
    (sort items
        (lambda (a b)
          (let ((a-num (cadr (or (assoc a items-order) '(0 0))))

;; state is the priority rollup of all states
;; status is the priority rollup of all completed states
;;
;; if test-name is an integer work off that instead of test-name test-path
;;
(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status #!key (comment #f))
  ;; establish info on incoming test followed by info on top level test
  (let* ((db           (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
	 (testdat1     (if (number? test-name)
	 (testdat      (if (number? test-name)
			   (db:get-test-info-by-id dbstruct run-id test-name)
			   #f))
	 (orig-test-id (if testdat1 (db:test-get-id testdat1) #f)) ;; the item
	 (test-name    (if testdat1 (db:test-get-testname testdat1) test-name))
         (testdat      (db:get-test-info dbstruct run-id test-name ""))
         (test-id      (db:test-get-id        testdat))
	 (item-path    (db:test-get-item-path (or testdat1 testdat))))
			   (db:get-test-info       dbstruct run-id test-name item-path)))
	 (test-id      (db:test-get-id testdat))
	 (test-name    (if (number? test-name)
			   (db:test-get-testname testdat)
			   test-name))
	 (item-path    (db:test-get-item-path testdat))
         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
         (tl-test-id   (db:test-get-id tl-testdat)))
    (print "Got here.")
    (sqlite3:with-transaction
     db
     (lambda ()
       (if orig-test-id (db:test-set-state-status-by-id dbstruct run-id orig-test-id state status comment))
       (if (not (equal? item-path "")) ;; only roll up IF we are an item
       (db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
       (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
	   (let* ((all-curr-states   (common:special-sort
				      (delete-duplicates
				       (let ((states (db:get-all-item-states   db run-id test-name)))
				       (let ((states (db:get-all-item-states db run-id test-name)))
					 (if state (cons state states) states)))
				      *common:std-states* >))
		  (all-curr-statuses (common:special-sort
				      (delete-duplicates
				       (let ((statuses (db:get-all-item-statuses db run-id test-name)))
					 (if (equal? state "COMPLETED")
					 (if (member state *common:ended-states*) ;; '("COMPLETED" "ARCHIVED"))
					     (cons status statuses)
					     statuses)))
				      *common:std-statuses* >))
		  (newstate          (if (null? all-curr-states) "NOT_STARTED" (car all-curr-states)))
		  (newstatus         (if (null? all-curr-statuses) "n/a" (car all-curr-statuses))))
	     (print "Setting toplevel to: " newstate "/" newstatus)
	     (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus #f)))))))
	     (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f)))))))
        
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)

;; call with state = #f to roll up with out accounting for state/status of this item
;;
;;    (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
;;      (if (not (equal? item-path "")) ;; if asked to do this for a specific item then do an incremental update