Megatest

Check-in [51ee5bb785]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed dashboard updater issues.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 51ee5bb785927f1ff43593ac7f90f3b00ed24236
User & Date: matt on 2023-01-24 08:16:28
Other Links: branch diff | manifest | tags
Context
2023-01-24
08:59
Put changes to ulex-full into ulex check-in: 5e8db5c53d user: matt tags: v2.0001
08:16
Fixed dashboard updater issues. check-in: 51ee5bb785 user: matt tags: v2.0001
01:25
Bumped version check-in: 0abd544e05 user: matt tags: v2.0001
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [504060146b] to [ff9b120b1b].

︙
132
133
134
135
136
137
138




139
140
141
142
143
144
145

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149








+
+
+
+








	tasksmod
	testsmod
	tree
	vgmod
        ducttape-lib
	)

;; globals to dashboard module
(define *updaters-running* #f)
(define *updaters-thread*  #f)

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2012-2017

Usage: dashboard [options]
  -h                    : this help
︙
3660
3661
3662
3663
3664
3665
3666
3667
3668


3669
3670
3671
3672
3673
3674
3675

3676
3677
3678
3679
3680
3681
3682

3664
3665
3666
3667
3668
3669
3670


3671
3672
3673
3674
3675
3676
3677
3678

3679
3680
3681
3682
3683
3684
3685
3686








-
-
+
+






-
+








     tabdat
     runnamepatt
     numruns
     testnamepatt
     keypatts)))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
  ;; (debug:catch-and-dump 
  ;;  (lambda ()
     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
       (dashboard:do-update-rundat tabdat)
       (let ((uidat (dboard:commondat-uidat commondat)))
	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))
   ;; "dashboard:runs-tab-updater"))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

(define (dashboard-main)
  (let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; not used for now, update for .db area and use for write access detection
︙
3713
3714
3715
3716
3717
3718
3719

3720
3721
3722
3723
3724
3725
3726

3727
3728
3729
3730
3731
3732
3733
3734


















3735
3736
3737
3738
3739
3740
3741
3742
3743
3744










3745
3746
3747
3748
3749
3750
3751

3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727




3728








3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749







3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766








+



-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+








	 tab-num: 1)
        ;; may not want this alive (manually merged it from v1.66)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 2)
	
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)
			     (if (not *updaters-thread*)
			     (dboard:commondat-updating-set! commondat #t))
			     (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			     (begin
			     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (dboard:commondat-updating-set! commondat #f)
			     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				 (begin
				   ;; (debug:print-info 0 *default-log-port* "Updater started...")
				   (set! *updaters-thread*
					 (make-thread
					  (lambda ()
					    (dboard:common-run-curr-updaters commondat))))
				   (thread-start! *updaters-thread*))
				 (begin
				   (debug:print-info 0 *default-log-port* "Updater restarted...")
				   (thread-resume! *updaters-thread*)))
			     (thread-sleep! 0.25)
			     (if (eq? (thread-state *updaters-thread*) 'running)
				 (begin
				   (debug:print-info 0 *default-log-port* "Updater suspended...")
				   (thread-suspend! *updaters-thread*))
				 (begin
				   (set! *updaters-thread* #f)
				   ;; (debug:print-info 0 *default-log-port* "Updater done...")
				   ))
			     1))))
      
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))
	(thread-start! th2)
	(thread-join! th2)))))
      ;; (let ((th1 (make-thread (lambda ()
      ;; 				(thread-sleep! 1)
      ;; 				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
      ;; 				) "update buttons once"))
      ;; 	    (th2 (make-thread iup:main-loop "Main loop")))
      ;; 	(thread-start! th2)
      ;; 	(thread-join! th2))
      
      (iup:main-loop)
      )))

(define (get-debugcontrolf)
  (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
    (if (common:file-exists? debugcontrolf)
	debugcontrolf
	#f)))
︙

Modified dcommon.scm from [bd38a07213] to [c806284f28].

︙
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

82
83
84
85
86
87
88

89
90
91
92
93
94
95








-









;; yes, this is non-ideal 
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)

(define *last-monitor-update-time* 0)
(define *exit-started* #f)


;;======================================================================
;; C O M M O N   D A T A   S T R U C T U R E
;;======================================================================
;; 
;; data common to all tabs goes here
;;
︙

Modified runsmod.scm from [620d1b5371] to [2064556098].

︙
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281

267
268
269
270
271
272
273

274
275
276
277
278
279
280
281








-
+








	   (args:get-arg "-one-pass"))
      (exit 0))

  (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))

  (let* ((num-running             (rmt:get-count-tests-running run-id))
	 (num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
	 (job-group-limit         (let ((jobg-count (configf:lookup *configdat* "jobgroups" jobgroup)))
	 (job-group-limit         (let ((jobg-count (configf:lookup-number *configdat* "jobgroups" jobgroup)))
				    (if (string? jobg-count)
					(string->number jobg-count)
					jobg-count))))
    (if (> (+ num-running num-running-in-jobgroup) 0)
	(runs:inc-can-run-more-tests-count runsdat)) ;; (set! *runs:can-run-more-tests-count* (+ *runs:can-run-more-tests-count* 1)))
    (if (not (eq? *last-num-running-tests* num-running))
	(begin
︙

Modified ulex-full/dbmgr.scm from [cc60b18701] to [afcee6ee9f].

︙
332
333
334
335
336
337
338
339

340
341
342
343
344
345
346

332
333
334
335
336
337
338

339
340
341
342
343
344
345
346








-
+








				    (set! res (send-receive uconn (conndat-hostport cdat) cmd params)))
				  "send-receive thread")))
      ;; (thread-start! th1)
      ;; (thread-join! th1)   ;; gratuitious thread stuff is so that mailbox is not used in primordial thead
      ;; since we accessed the server we can bump the expires time up
      (conndat-expires-set! cdat (+ (current-seconds)
				    (server:expiration-timeout)
				    -2)) ;; two second margin for network time misalignments etc.
				    -10)) ;; ten second margin for network time misalignments etc.
      res)))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
;; Purpose - call the main.db server and request a server be started
;; for the given area path and dbname
︙

Modified ulex-full/ulex.scm from [1b6751adf3] to [2c2b2f2441].

︙
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283

269
270
271
272
273
274
275

276
277
278
279
280
281
282
283








-
+









(define (send-via-mailbox uconn host-port cmd data)
  (let* ((cmbox     (get-cmbox uconn)) ;; would it be better to keep a stack of mboxes to reuse?
	 (qrykey    (car cmbox))
	 (mbox      (cdr cmbox))
	 (mbox-time (current-milliseconds))
	 (sres      (send uconn host-port qrykey cmd data))) ;; short res
    (if (eq? sres 'ack)
    (if (eq? sres 'ack) ;; BUG: change to be less than server:expiration-timeout?
	(let* ((mbox-timeout-secs    120 #;(if (eq? 'primordial (thread-name (current-thread)))
				     #f
				     120)) ;; timeout)
	       (mbox-timeout-result 'MBOX_TIMEOUT)
	       (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
	       (mbox-receive-time    (current-milliseconds)))
	  ;; (put-cmbox uconn cmbox) ;; reuse mbox and cookie. is it worth it?
︙
436
437
438
439
440
441
442
443

444
445
446
447
448
449
450

436
437
438
439
440
441
442

443
444
445
446
447
448
449
450








-
+








	      (run-time (- end-time start-time)))
	 (case (work-method)
	   ((direct) result)
	   (else
	    (print "ULEX: work "cmd", "params" done in "run-time" ms")
	    ;; send 'response as cmd and result as params
	    (send uconn rem-host-port qrykey 'response result) ;; could check for ack
	    (print "ULEX: response sent back to "rem-host-port" in "(- (current-milliseconds) end-time))))))
	    (print "ULEX: response sent back to "rem-host-port" for "qrykey" in "(- (current-milliseconds) end-time)"ms")))))
      (MBOX_TIMEOUT 'do-work-timeout)
      (else
       (print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params")))))

;; NEW APPROACH:
;;   
(define (process-work-queue uconn)
︙

Modified ulex/ulex.scm from [1b6751adf3] to [1928dcc443].

︙
436
437
438
439
440
441
442
443

444
445
446
447
448
449
450

436
437
438
439
440
441
442

443
444
445
446
447
448
449
450








-
+








	      (run-time (- end-time start-time)))
	 (case (work-method)
	   ((direct) result)
	   (else
	    (print "ULEX: work "cmd", "params" done in "run-time" ms")
	    ;; send 'response as cmd and result as params
	    (send uconn rem-host-port qrykey 'response result) ;; could check for ack
	    (print "ULEX: response sent back to "rem-host-port" in "(- (current-milliseconds) end-time))))))
	    (print "ULEX: response sent back to "rem-host-port" for "qrykey" in "(- (current-milliseconds) end-time)"ms")))))
      (MBOX_TIMEOUT 'do-work-timeout)
      (else
       (print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params")))))

;; NEW APPROACH:
;;   
(define (process-work-queue uconn)
︙

This page was generated in about 0.132s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00