Megatest

Check-in [6b6111eed8]
Login
Overview
Comment:more fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.62-no-rpc
Files: files | file ages | folders
SHA1: 6b6111eed81400e37b49beece7672a4bd2cdbba0
User & Date: matt on 2016-11-24 20:15:34
Other Links: branch diff | manifest | tags
Context
2016-11-24
22:54
Migrated some (but not all) calls to newer set state status check-in: 5af8fddcf7 user: matt tags: v1.62-no-rpc
20:15
more fixes check-in: 6b6111eed8 user: matt tags: v1.62-no-rpc
16:27
fixed few things check-in: 6701aeaf33 user: matt tags: v1.62-no-rpc
Changes

Modified common.scm from [4045fa5b1b] to [23b7fa8562].

352
353
354
355
356
357
358
359

360
361
362

363
364
365
366
367
368
369
370
371
372
373
374
375



376
377
378
379
380
381
382
352
353
354
355
356
357
358

359
360
361

362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385







-
+


-
+













+
+
+








(define *common:std-states*   
  '((0 "ARCHIVED")
    (1 "STUCK")
    (2 "KILLREQ")
    (3 "KILLED")
    (4 "NOT_STARTED")
    (5 "RUNNING")
    (5 "COMPLETED")
    (6 "LAUNCHED")
    (7 "REMOTEHOSTSTART")
    (8 "COMPLETED")
    (8 "RUNNING")
    ))

(define *common:std-statuses*
  '(;; (0 "DELETED")
    (1 "n/a")
    (2 "PASS")
    (3 "CHECK")
    (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
  '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE"))

(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))))

Modified db.scm from [9478297bc8] to [f77a24d830].

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
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)))
	 (testdat1     (if (number? test-name)
	 (testdat      (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))))
			   (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 ()
       (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
       (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)))
				       (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")
					 (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 test-id newstate newstatus #f)))))))
	     (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