Megatest

;;    ;; 	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
;;    ;; 	(db:general-call dbdat 'state-status     (list state status test-id)))
;;    (db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
;;    ;; process the test_data table
;;    (if (and test-id state status (equal? status "AUTO")) 
;; 	(db:test-data-rollup dbstruct run-id test-id status))
;;    (mt:process-triggers dbstruct run-id test-id state status)))

;; NOT FINISHED 
(define (db:calc-state-status-toplevel state status tl-state tl-status)
  `(,state ,status))

;;   (match state
;;     (("COMPLETED")
;;      (match `(,tl-state ,tl-status)
;;        (("COMPLETED" "PASS") `(,state ,status))
;;        (("COMPLETED" thestatus)
;; 	(case (string->symbol thestatus)
;; 	  ((ABORT CHECK DEAD)
;; 	   (if `("COMPLETED" ,thestatus))
;; 	(match `(,thestatus ,status)
;; 	  (("FAIL" "ABORT") '("COMPLETED" "ABORT"))
;; 	  (("FAIL" "CHECK") '("COMPLETED" "CHECK"))
;; 	  (("FAIL" "DEAD")  '("COMPLETED" "DEAD"))
;; 	  (("WARN" "FAIL")  '("COMPLETED" "FAIL"))
;; 	  (("WARN" "CHECK") '("COMPLETED" "CHECK"))
;; 	  (("WARN" "DEAD")
       

(define (db:set-state-status-and-roll-up-items-fast dbstruct run-id test-name item-path state status comment)
  ;; establish info on incoming test followed by info on top level test
  ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met
  (mutex-lock! *db-transaction-mutex*)
  (db:with-db
   dbstruct #f #f
   (lambda (db)
     (let ((tr-res
	    (sqlite3:with-transaction
	     db
	     (lambda ()
	       (let* ((testdat      (if (number? test-name)
					(db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
					(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   (if tl-testdat
					(db:test-get-id tl-testdat)
					#f)))
		 (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
		     (db:general-call dbstruct 'set-test-start-time (list test-id)))
		 (if (member state '("LAUNCHED" "REMOTEHOSTSTART" "RUNNING"))
		     (begin ;; set test to launched and top level to RUNNING and we are done
		       (if tl-test-id
			   (db:test-set-state-status db run-id tl-test-id "RUNNING" #f #f)) ;; we are still in the transaction - must access the db and not the dbstruct
		       (db:test-set-state-status db run-id test-id state status #f))
		     (begin ;; 
		       (db:test-set-state-status db run-id test-id state status comment) ;; this call sets the item state/status
		       (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
			   (let* ((tl-state  (db:test-get-state tl-testdat))
				  (tl-status (db:test-get-status tl-testdat))
				  (newss     (db:calc-state-status-toplevel state status tl-state tl-status)))
			     (match newss
			       ((new-tl-state new-tl-status)
				(db:test-set-state-status db run-id tl-test-id new-tl-state new-tl-status))
			       (else
				#f)))))))))))
       (mutex-unlock! *db-transaction-mutex*)
       (if (and test-id state status (equal? status "AUTO")) 
	   (db:test-data-rollup dbstruct run-id test-id status))
       tr-res))))


;; state is the priority rollup of all states
;; status is the priority rollup of all completed statesfu
;;
;; 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 comment)

              (sqlite3:with-transaction
               db
               (lambda ()
                 ;; NB// Pass the db so it is part fo the transaction
                 (db:test-set-state-status db run-id test-id state status comment) ;; this call sets the item state/status
                 (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 dbstruct run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test
			      						  (state-stauses (db:roll-up-rules state-status-counts state status))
			    (state-stauses        (db:roll-up-rules state-status-counts state status))
                          (newstate (car state-stauses))
                          (newstatus (cadr state-stauses)))
                       (debug:print 4 *default-log-port* "BB> tl-test-id="tl-test-id" ; "test-name":"item-path" newstate="newstate" newstatus="newstatus" len(sscs)="(length state-status-counts)  " state-status-counts: "
							(apply conc
                  (map (lambda (x)
                     (conc
                     		(with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | "))