Megatest

Check-in [fc4e43d81e]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-stackdumpfix
Files: files | file ages | folders
SHA1: fc4e43d81e899a7090e03f972a101004bc94f821
User & Date: bjbarcla on 2017-01-06 20:28:48
Other Links: branch diff | manifest | tags
Context
2017-01-06
21:54
utils/plot-code.scm check-in: 064872f8bc user: matt tags: v1.63-stackdumpfix
20:28
wip check-in: fc4e43d81e user: bjbarcla tags: v1.63-stackdumpfix
14:31
wip check-in: b3d324d50f user: bjbarcla tags: v1.63-stackdumpfix
Changes

Modified db.scm from [a169cd3703] to [bafb822f96].

1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
	"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;"
	run-id))))

;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
  ;;(mutex-lock! *db-stats-mutex*)
  (db:with-db
   dbstruct
   #f
   #f

   (lambda (db)
     ;; remove previous data







|







1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
	"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;"
	run-id))))

;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
  (mutex-lock! *db-stats-mutex*)
  (db:with-db
   dbstruct
   #f
   #f

   (lambda (db)
     ;; remove previous data
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
		(for-each
		 (lambda (dat)
		   (sqlite3:execute stmt1 run-id (car dat)(cadr dat))
		   (apply sqlite3:execute stmt2 run-id dat))
		 stats)))))
       (sqlite3:finalize! stmt1)
       (sqlite3:finalize! stmt2)
       ;;(mutex-unlock! *db-stats-mutex*)
       res))))

(define (db:get-main-run-stats dbstruct run-id)
  (db:with-db
   dbstruct
   #f ;; this data comes from main
   #f







|







1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
		(for-each
		 (lambda (dat)
		   (sqlite3:execute stmt1 run-id (car dat)(cadr dat))
		   (apply sqlite3:execute stmt2 run-id dat))
		 stats)))))
       (sqlite3:finalize! stmt1)
       (sqlite3:finalize! stmt2)
       (mutex-unlock! *db-stats-mutex*)
       res))))

(define (db:get-main-run-stats dbstruct run-id)
  (db:with-db
   dbstruct
   #f ;; this data comes from main
   #f
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
	 (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)))


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







>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>







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
3220
3221
3222
	 (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)))
    (mutex-lock! *db-stats-mutex*)
    (let ((tr-res
           (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))))))
          (mutex-unlock! *db-stats-mutex*))
      trres)))

(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

Modified rmt.scm from [33def41478] to [ef5ad8a7b9].

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
                                  ((exn)(vector #f "other fail" (print-call-chain)))))
			 (else
			  (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported")
			  (exit))))
	     (success  (if (vector? dat) (vector-ref dat 0) #f))
	     (res      (if (vector? dat) (vector-ref dat 1) #f)))
	(if (vector? conninfo)(http-transport:server-dat-update-last-access conninfo)) ;; refresh access time
        (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9. conninfo=" conninfo " dat=" dat)
	(if success
	    (case (remote-transport *runremote*)
	      ((http) res)
	      (else
	       (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " is unknown")
	       (exit 1)))
	    (begin







|







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
                                  ((exn)(vector #f "other fail" (print-call-chain)))))
			 (else
			  (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported")
			  (exit))))
	     (success  (if (vector? dat) (vector-ref dat 0) #f))
	     (res      (if (vector? dat) (vector-ref dat 1) #f)))
	(if (vector? conninfo)(http-transport:server-dat-update-last-access conninfo)) ;; refresh access time
        (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9. conninfo=" conninfo " dat=" dat " *runremote* = "*runremote*)
	(if success
	    (case (remote-transport *runremote*)
	      ((http) res)
	      (else
	       (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " is unknown")
	       (exit 1)))
	    (begin