Megatest

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

(define *common:badly-ended-states* ;; these roll up as CHECK, i.e. results need to be checked
  '("KILLED" "KILLREQ" "STUCK" "INCOMPLETE"))
  '("KILLED" "KILLREQ" "STUCK" "INCOMPLETE" "DEAD"))

(define *common:running-states*     ;; test is either running or can be run
  '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED"))

(define *common:cant-run-states*    ;; These are stopping conditions that prevent a test from being run
  '("COMPLETED" "KILLED" "UNKNOWN" "INCOMPLETE" "ARCHIVED"))

(define *common:not-started-ok-statuses* ;; if not one of these statuses when in not_started state treat as dead
  '("n/a" "na" "PASS" "FAIL" "WARN" "CHECK" "WAIVED" "DEAD" "SKIP"))

(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))))
                (b-num (cadr (or (assoc b items-order) '(0 0)))))
            (acomp a-num b-num))))))

;; These are stopping conditions that prevent a test from being run
(define *common:cant-run-states-sym* 
  '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE ABORT ARCHIVED))

;; given a toplevel with currstate, currstatus apply state and status
;;  => (newstate . newstatus)
(define (common:apply-state-status currstate currstatus state status)
  (let* ((cstate  (string->symbol (string-downcase currstate)))
         (cstatus (string->symbol (string-downcase currstatus)))
         (sstate  (string->symbol (string-downcase state)))
         (sstatus (string->symbol (string-downcase status)))
         (nstate  #f)
         (nstatus #f))
    (set! nstate
          (case cstate
            ((completed not_started killed killreq stuck archived) 
             (case sstate ;; completed -> sstate
               ((completed killed killreq stuck archived) completed)
               ((running remotehoststart launched)        running)
               (else                                      unknown-error-1)))
            ((running remotehoststart launched)
             (case sstate
               ((completed killed killreq stuck archived) #f) ;; need to look at all items
               ((running remotehoststart launched)        running)
               (else                                      unknown-error-2)))
            (else unknown-error-3)))
    (set! nstatus
          (case sstatus
            ((pass)
             (case nstate
               ((pass n/a deleted)     pass)
               ((warn)                 warn)
               ((fail)                 fail)
               ((check)               check)
               ((waived)             waived)
               ((skip)                 skip)
               ((stuck/dead)          stuck)
               ((abort)               abort)
               (else        unknown-error-4)))
            ((warn)
             (case nstate
               ((pass warn n/a skip deleted)   warn)
               ((fail)                         fail)
               ((check)                       check)
               ((waived)                     waived)
               ((stuck/dead)                  stuck)
               (else                unknown-error-5)))
            ((fail)
             (case nstate
               ((pass warn fail check n/a waived skip deleted stuck/dead stuck)  fail)
               ((abort)                                                         abort)
               (else                                                  unknown-error-6)))
            (else    unknown-error-7)))
    (cons 
     (if nstate  (symbol->string nstate)  nstate)
     (if nstatus (symbol->string nstatus) nstatus))))
;; ;; given a toplevel with currstate, currstatus apply state and status
;; ;;  => (newstate . newstatus)
;; (define (common:apply-state-status currstate currstatus state status)
;;   (let* ((cstate  (string->symbol (string-downcase currstate)))
;;          (cstatus (string->symbol (string-downcase currstatus)))
;;          (sstate  (string->symbol (string-downcase state)))
;;          (sstatus (string->symbol (string-downcase status)))
;;          (nstate  #f)
;;          (nstatus #f))
;;     (set! nstate
;;           (case cstate
;;             ((completed not_started killed killreq stuck archived) 
;;              (case sstate ;; completed -> sstate
;;                ((completed killed killreq stuck archived) completed)
;;                ((running remotehoststart launched)        running)
;;                (else                                      unknown-error-1)))
;;             ((running remotehoststart launched)
;;              (case sstate
;;                ((completed killed killreq stuck archived) #f) ;; need to look at all items
;;                ((running remotehoststart launched)        running)
;;                (else                                      unknown-error-2)))
;;             (else unknown-error-3)))
;;     (set! nstatus
;;           (case sstatus
;;             ((pass)
;;              (case nstate
;;                ((pass n/a deleted)     pass)
;;                ((warn)                 warn)
;;                ((fail)                 fail)
;;                ((check)               check)
;;                ((waived)             waived)
;;                ((skip)                 skip)
;;                ((stuck/dead)          stuck)
;;                ((abort)               abort)
;;                (else        unknown-error-4)))
;;             ((warn)
;;              (case nstate
;;                ((pass warn n/a skip deleted)   warn)
;;                ((fail)                         fail)
;;                ((check)                       check)
;;                ((waived)                     waived)
;;                ((stuck/dead)                  stuck)
;;                (else                unknown-error-5)))
;;             ((fail)
;;              (case nstate
;;                ((pass warn fail check n/a waived skip deleted stuck/dead stuck)  fail)
;;                ((abort)                                                         abort)
;;                (else                                                  unknown-error-6)))
;;             (else    unknown-error-7)))
;;     (cons 
;;      (if nstate  (symbol->string nstate)  nstate)
;;      (if nstatus (symbol->string nstatus) nstatus))))
               
;;======================================================================
;; D E B U G G I N G   S T U F F 
;;======================================================================

(define *verbosity*         1)
(define *logging*           #f)

;;======================================================================

;; each db entry is a pair ( db . dbfilepath )
(defstruct dbr:dbstruct 
  (tmpdb  #f)
  (mtdb   #f)
  (refndb #f))

;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts
  (state #f)
  (status #f)
  (count  0)) 

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================

(define (db:general-sqlite-error-dump exn stmt . params)
  (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?

         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
         (tl-test-id   (db:test-get-id tl-testdat)))
    (sqlite3:with-transaction
     db
     (lambda ()
       (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* ((state-status-counts  (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
		  (running              (length (filter (lambda (x)
							  (member (dbr:counts-state x) *common:running-states*))
							state-status-counts)))
		  (bad-not-started      (length (filter (lambda (x)
							  (and (equal? (dbr:counts-state x) "NOT_STARTED")
							       (not (member (dbr:counts-status x)
									    *common:not-started-ok-statuses*))))
							state-status-counts)))
	   (let* ((all-curr-states   (common:special-sort
				      (delete-duplicates
		  (all-curr-states   (common:special-sort  ;; worst -> best (sort of)
                                      (delete-duplicates
				       (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
                                       (cons state (map dbr:counts-state state-status-counts)))
                                      *common:std-states* >))
                  (all-curr-statuses (common:special-sort  ;; worst -> best
                                      (delete-duplicates
				       (let ((statuses (db:get-all-item-statuses db run-id test-name)))
					 (if (member state *common:ended-states*) ;; '("COMPLETED" "ARCHIVED"))
					     (cons (if (member state *common:badly-ended-states*)
						       "FAIL"
						       status)
				       (cons status (map dbr:counts-status state-status-counts)))
						   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))))
		  (newstate          (if (> running 0)
					 "RUNNING"
					 (if (> bad-not-started 0)
					     "COMPLETED"
					     (car all-curr-states))))
		  (newstatus         (if (> bad-not-started 0)
					 "CHECK"
					 (car all-curr-statuses))))
	     ;; (print "Setting toplevel to: " newstate "/" newstatus)
	     (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
;;

;;    ;; 	  ;; NOTE: No else clause needed for this case
;;    ;; 	  (case (string->symbol status)
;;    ;; 	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;    ;; 	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;    ;; 	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;;    ;; 	  #f)
;;    ;; 	)))

(define (db:get-all-state-status-counts-for-test db run-id test-name item-path)
  (sqlite3:map-row
   (lambda (state status count)
     (make-dbr:counts state: state status: status count: count))
   db
   "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;"
   run-id test-name item-path))


(define (db:get-all-item-states db run-id test-name)
  (sqlite3:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT state FROM tests WHERE item_path != '' AND state != 'DELETED' AND run_id=? AND testname=?"
   run-id test-name))