41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
;;======================================================================
;; each db entry is a pair ( db . dbfilepath )
(defstruct dbr:dbstruct
(tmpdb #f)
(mtdb #f)
(refndb #f))
;;======================================================================
;; 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?
|
>
>
>
>
>
>
>
>
|
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
;;======================================================================
;; 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?
|
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
|
(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* ((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 (if (member state *common:badly-ended-states*)
"FAIL"
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
;;
|
>
>
>
>
>
>
>
>
>
|
|
<
|
|
|
|
<
<
<
<
|
<
<
|
>
>
>
>
|
>
>
|
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
|
(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)))
(all-curr-states (common:special-sort ;; worst -> best (sort of)
(delete-duplicates
(cons state (map dbr:counts-state state-status-counts)))
*common:std-states* >))
(all-curr-statuses (common:special-sort ;; worst -> best
(delete-duplicates
(cons status (map dbr:counts-status state-status-counts)))
*common:std-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
;;
|
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
|
;; ;; ;; 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-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))
|
>
>
>
>
>
>
>
>
>
|
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
|
;; ;; ;; 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))
|