Megatest

Check-in [b850770938]
Login
Overview
Comment:deal with empty response From: 82ee02c9c1b7012786a26a103cd6d6380b61352a User: matt
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.65-diet2-cm1
Files: files | file ages | folders
SHA1: b85077093857739fd4aa820d23c5e96898d452da
User & Date: matt on 2021-02-26 07:53:39
Other Links: branch diff | manifest | tags
Context
2021-02-26
07:53
deal with empty response From: 82ee02c9c1b7012786a26a103cd6d6380b61352a User: matt Leaf check-in: b850770938 user: matt tags: v1.65-diet2-cm1 (unpublished)
07:53
Merged in latest From: 14db3c2571c703c23f8b627c1d3ca06d22870c57 User: matt check-in: 74a5cd0abb user: matt tags: v1.65-diet2-cm1 (unpublished)
Changes

Modified db.scm from [2f9964a2a3] to [f9ddaf6bbc].

4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037

4038
4039
4040
4041
4042

4043
4044
4045
4046
4047
4048
4049
4050

    (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
	(begin
	  ;; is there a rollup lock? If not, take it
	  (sqlite3:with-transaction
	   no-sync-db
	   (lambda ()
	     (handle-exceptions
	      exn
	      (debug:print 0 *default-log-port* "EXCEPTION: exn="exn)
	      (let* ((rollup-lock-time (db:no-sync-get/default no-sync-db rollup-lock-key #f))
		     (waiting-lock-time (db:no-sync-get/default no-sync-db waiting-lock-key #f)))
		(if rollup-lock-time ;; someone is doing a rollup
		    (if (not waiting-lock-time) ;; no one is waiting
			(begin
			  (set! wait-flag #t)
			  (set! rollup-flag #t)
			  (db:no-sync-set no-sync-db waiting-lock-key (current-seconds)))) ;; we are going to wait
		    (begin
		      (set! rollup-flag #t)
		      (db:no-sync-set no-sync-db rollup-lock-key (current-seconds)))))))
	   (if wait-flag
	       (let loop ((count 100))
		 (thread-sleep! 2)
		 (if (and (not (db:no-sync-get/default no-sync-db waiting-lock-key #f))
			  (> count 0))
		     (loop (+ count 1))
		     (sqlite3:with-transaction
		      no-sync-db
		      (lambda ()
			(db:no-sync-set no-sync-db rollup-lock-key (current-seconds))
			(db:no-sync-del! no-sync-db waiting-lock-key)))))))
	  ;; now the rollup
	  (if rollup-flag ;; put this into a thread

	      (thread-start! (make-thread
			      (lambda ()
				(db:roll-up-test-state-status dbstruct run-id test-name state status)
				(db:no-sync-del! no-sync-db rollup-flag))
			      (conc "thread for run-id: " run-id " test-name: " test-name))))))))


;; I'd like to remove the need for item-path - it is logically not needed here
;; for now we pass in state and status - NOTE: There is a possible race if a test
;; is rapidly re-run while an earlier run is waiting to rollup.
;;
(define (db:roll-up-test-state-status dbstruct run-id test-name state status)
  (let* ((testdat      (if (number? test-name)
			   (db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id







<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|


>
|
|
|
|
|
>
|







4004
4005
4006
4007
4008
4009
4010


4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050

    (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
	(begin
	  ;; is there a rollup lock? If not, take it
	  (sqlite3:with-transaction
	   no-sync-db
	   (lambda ()


	     ;; (debug:print 0 *default-log-port* "EXCEPTION: exn="exn)
	     (let* ((rollup-lock-time  (db:no-sync-get/default no-sync-db rollup-lock-key #f))
		    (waiting-lock-time (db:no-sync-get/default no-sync-db waiting-lock-key #f)))
	       (if rollup-lock-time ;; someone is doing a rollup
		   (if (not waiting-lock-time) ;; no one is waiting
		       (begin
			 (set! wait-flag #t)
			 (set! rollup-flag #t)
			 (db:no-sync-set no-sync-db waiting-lock-key (current-seconds)))) ;; we are going to wait
		   (begin
		     (set! rollup-flag #t)
		     (db:no-sync-set no-sync-db rollup-lock-key (current-seconds)))))))
	  (if wait-flag
	      (let loop ((count 10)) ;; about 20 seconds
		(thread-sleep! 2)
		(if (and (not (db:no-sync-get/default no-sync-db waiting-lock-key #f))
			 (> count 0))
		    (loop (+ count 1))
		    (sqlite3:with-transaction
		     no-sync-db
		     (lambda ()
		       (db:no-sync-set no-sync-db rollup-lock-key (current-seconds))
		       (db:no-sync-del! no-sync-db waiting-lock-key))))))
	  ;; now the rollup
	  (if rollup-flag ;; put this into a thread
	      (begin
		;; (thread-start! (make-thread
		;; 	      (lambda ()
		(db:roll-up-test-state-status dbstruct run-id test-name state status)
		(db:no-sync-del! no-sync-db rollup-lock-key))
	      ;; (conc "thread for run-id: " run-id " test-name: " test-name))))))))
	      )))))
	      
;; I'd like to remove the need for item-path - it is logically not needed here
;; for now we pass in state and status - NOTE: There is a possible race if a test
;; is rapidly re-run while an earlier run is waiting to rollup.
;;
(define (db:roll-up-test-state-status dbstruct run-id test-name state status)
  (let* ((testdat      (if (number? test-name)
			   (db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
4058
4059
4060
4061
4062
4063
4064


4065
4066
4067
4068
4069
4070
4071
4072
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       ;; NB// Pass the db so it is part fo the transaction
       ;; item-path is used in get-all-state-status counts to exclude current state/status of THIS test
       ;; but with the state/status being set earlier this is not needed any longer
       (let* ((state-status-counts  (db:get-all-state-status-counts-for-testname dbstruct run-id test-name))


	      (state-statuses       (db:roll-up-rules state-status-counts state status))
	      (newstate             (if (null? state-statuses)
					state
					(car state-statuses)))
	      (newstatus            (if (null? state-statuses)
					status
					(cadr state-statuses))))
	 (if tl-test-id







>
>
|







4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       ;; NB// Pass the db so it is part fo the transaction
       ;; item-path is used in get-all-state-status counts to exclude current state/status of THIS test
       ;; but with the state/status being set earlier this is not needed any longer
       (let* ((state-status-counts  (db:get-all-state-status-counts-for-testname dbstruct run-id test-name))
	      (state-statuses       (if (null? state-status-counts)
					'()
					(db:roll-up-rules state-status-counts state status)))
	      (newstate             (if (null? state-statuses)
					state
					(car state-statuses)))
	      (newstatus            (if (null? state-statuses)
					status
					(cadr state-statuses))))
	 (if tl-test-id
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
               db
               (lambda ()
                   (let* ((state-status-counts  (db:get-all-state-status-counts-for-run dbstruct run-id))
			  (state-statuses        (db:roll-up-rules state-status-counts #f #f ))
                          (newstate             (if (null? state-statuses)
						    curr-state
						    (car state-statuses)))
			  (newstatus            (if (null? state-status)
						    curr-status
						    (cadr state-statuses))))
                    (if (or (not (eq? newstate curr-state)) (not (eq?  newstatus curr-status)))
                   (db:set-run-state-status dbstruct run-id newstate newstatus )))))))
         ;; (mutex-unlock! *db-transaction-mutex*)
         tr-res))))








|







4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
               db
               (lambda ()
                   (let* ((state-status-counts  (db:get-all-state-status-counts-for-run dbstruct run-id))
			  (state-statuses        (db:roll-up-rules state-status-counts #f #f ))
                          (newstate             (if (null? state-statuses)
						    curr-state
						    (car state-statuses)))
			  (newstatus            (if (null? state-statuses)
						    curr-status
						    (cadr state-statuses))))
                    (if (or (not (eq? newstate curr-state)) (not (eq?  newstatus curr-status)))
                   (db:set-run-state-status dbstruct run-id newstate newstatus )))))))
         ;; (mutex-unlock! *db-transaction-mutex*)
         tr-res))))