Megatest

Diff
Login

Differences From Artifact [f1fd1d7a39]:

To Artifact [eb86be463d]:


3172
3173
3174
3175
3176
3177
3178


3179

3180

3181
3182







3183
3184
3185


3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197















3198
3199

3200
3201
3202
3203
3204
3205
3206
3172
3173
3174
3175
3176
3177
3178
3179
3180

3181
3182
3183


3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195












3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211

3212
3213
3214
3215
3216
3217
3218
3219







+
+
-
+

+
-
-
+
+
+
+
+
+
+



+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+







	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))
     (mt:process-triggers run-id test-id state status)))

;; 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:roll-up-items-state-status dbstruct run-id test-name item-path state status)
(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status #!key (comment #f))
  (let* ((db      (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
	 (testdat1 (if (number? test-name)
         (testdat (db:get-test-info dbstruct run-id test-name ""))
         (test-id (db:test-get-id testdat)))
		       (db:get-test-info-by-id dbstruct run-id test-name)
		       #f))
	 (orig-test-id (db:test-get-id testdat1)) ;; the item
	 (test-name (db:test-get-testname testdat1))
         (testdat   (db:get-test-info dbstruct run-id test-name ""))
         (test-id   (db:test-get-id        testdat))
	 (item-path (db:test-get-item-path testdat1)))
    (sqlite3:with-transaction
     db
     (lambda ()
       (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
       (let* ((all-curr-states   (common:special-sort
                                  (cons state (db:get-all-item-states   db run-id test-name))
                                  *common:std-states* >))
              (all-curr-statuses (common:special-sort
                                  (let ((statuses (db:get-all-item-statuses db run-id test-name)))
                                    (if (equal? state "COMPLETED")
                                        (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))))
         (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus #f))))))
	   (let* ((all-curr-states   (common:special-sort
				      (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
				       (let ((statuses (db:get-all-item-statuses db run-id test-name)))
					 (if (equal? state "COMPLETED")
					     (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))))
	     (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus #f)))))))
        
(define db:roll-up-pass-fail-counts db:roll-up-items-state-status)
(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
;;          (let* ((dbdat         (db:get-db dbstruct run-id))
;;                 (toptestdat    (db:get-test-info dbstruct run-id test-name item-path))