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
|
;; 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))
(let* ((db (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
(testdat1 (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))))
(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
(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: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
|
>
|
<
<
<
|
|
>
>
>
|
>
>
|
|
|
|
>
|
|
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
3220
3221
3222
|
;; 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)))
(testdat (if (number? test-name)
(db:get-test-info-by-id dbstruct run-id test-name)
(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 ()
(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)))
(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 (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 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
|