Megatest

Check-in [e918c4732a]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Partially factored out uidat into a field in commondat
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dashboard-refactor
Files: files | file ages | folders
SHA1: e918c4732a06e07eefd590bc424c4a0a6dd41f6e
User & Date: mrwellan on 2016-07-07 09:12:24
Other Links: branch diff | manifest | tags
Context
2016-07-07
11:14
Merged dashboard refactor back into v1.61 (actually did it this time) check-in: 56322320c5 user: mrwellan tags: v1.61
09:12
Partially factored out uidat into a field in commondat Closed-Leaf check-in: e918c4732a user: mrwellan tags: dashboard-refactor
2016-07-06
08:43
wrong struct being accessed check-in: 4c7f2178b5 user: mrwellan tags: dashboard-refactor
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dashboard.scm from [91929ed396] to [280309e8e7].

︙︙
87
88
89
90
91
92
93


94
95
96
97
98
99
100

101
102
103
104
105
106
107

      (exit)))

(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))



(defstruct dboard:commondat
  curr-tab-num
  please-update  
  tabdats
  update-mutex
  updaters 
  updating

  hide-not-hide-tabs
  )

(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)








>
>







>








87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

      (exit)))

(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  curr-tab-num
  please-update  
  tabdats
  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  )

(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
︙︙
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134


(define (dboard:common-set-tabdat! commondat tabnum tabdat)
  (hash-table-set!
   (dboard:commondat-tabdats commondat)
   tabnum
   tabdat))

;; create a stuct for all the miscellaneous state
;;
(defstruct dboard:tabdat 
  allruns 
  allruns-by-id
  buttondat 
  command
  command-tb 








|








123
124
125
126
127
128
129
130
131
132
133
134
135
136
137


(define (dboard:common-set-tabdat! commondat tabnum tabdat)
  (hash-table-set!
   (dboard:commondat-tabdats commondat)
   tabnum
   tabdat))

;; data for each specific tab goes here
;;
(defstruct dboard:tabdat 
  allruns 
  allruns-by-id
  buttondat 
  command
  command-tb
︙︙
166
167
168
169
170
171
172

173
174
175
176
177
178
179

  status-ignore-hash
  statuses
  target
  test-patts
  tests
  tests-tree
  tot-runs   

  updater-for-runs
  )

(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))









>








169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

  status-ignore-hash
  statuses
  target
  test-patts
  tests
  tests-tree
  tot-runs   
;;  uidat
  updater-for-runs
  )

(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))
︙︙
208
209
210
211
212
213
214













215
216
217
218
219
220
221

	      start-test-offset:    0
	      state-ignore-hash:    (make-hash-table)
	      status-ignore-hash:   (make-hash-table)
	      )))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))














;; data for runs, tests etc
;;
(defstruct dboard:rundat
  ;; new system
  runs-index    ;; target/runname => colnum
  tests-index   ;; testname/itempath => rownum








>
>
>
>
>
>
>
>
>
>
>
>
>








212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

	      start-test-offset:    0
	      state-ignore-hash:    (make-hash-table)
	      status-ignore-hash:   (make-hash-table)
	      )))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))

(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))

  ;; HACK ALERT: this is a hack, please fix.
  (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
  
  (dboard:tabdat-keys-set! tabdat (rmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
  (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
  )

;; data for runs, tests etc
;;
(defstruct dboard:rundat
  ;; new system
  runs-index    ;; target/runname => colnum
  tests-index   ;; testname/itempath => rownum
︙︙
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

		     status: status)))
	  (sparse-array-set! (dboard:rundat-matrix-dat dat) col-num row-num tdat)
	  tdat)
	#f)))

(define *dashboard-mode* (string->symbol (or (configf:lookup *configdat* "dashboard" "mode") "dashboard")))
  
(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))

  ;; HACK ALERT: this is a hack, please fix.
  (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
  
  (dboard:tabdat-keys-set! tabdat (rmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
  (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
  )


(define *exit-started* #f)

;; sorting global data (would apply to many testsuites so leave it global for now)
;;
(define *tests-sort-options* (vector (vector "Sort +a" 'testname   "ASC")
				     (vector "Sort -a" 'testname   "DESC")








<
<
<
<
<
<
<
<
<
<
<
<
<








285
286
287
288
289
290
291













292
293
294
295
296
297
298

		     status: status)))
	  (sparse-array-set! (dboard:rundat-matrix-dat dat) col-num row-num tdat)
	  tdat)
	#f)))

(define *dashboard-mode* (string->symbol (or (configf:lookup *configdat* "dashboard" "mode") "dashboard")))
  














(define *exit-started* #f)

;; sorting global data (would apply to many testsuites so leave it global for now)
;;
(define *tests-sort-options* (vector (vector "Sort +a" 'testname   "ASC")
				     (vector "Sort -a" 'testname   "DESC")
︙︙
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333

	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

(debug:setup)

(define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))

(if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME")))








|








323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

(debug:setup)

;; (define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))

(if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME")))
︙︙
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469


    (dboard:tabdat-header-set! tabdat header)
    (dboard:tabdat-allruns-set! tabdat result)
    (debug:print-info 6 *default-log-port* "(dboard:tabdat-allruns tabdat) has " (length (dboard:tabdat-allruns tabdat)) " runs")
    maxtests))

(define *collapsed* (make-hash-table))
					; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj)

(define (toggle-hide lnum) ; fulltestname)
  (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum))
	 (fulltestname (iup:attribute btn "TITLE"))
	 (parts        (string-split fulltestname "("))
	 (basetestname (if (null? parts) "" (car parts))))
					;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
    (if (hash-table-ref/default *collapsed* basetestname #f)
	(begin








<

|








457
458
459
460
461
462
463

464
465
466
467
468
469
470
471
472


    (dboard:tabdat-header-set! tabdat header)
    (dboard:tabdat-allruns-set! tabdat result)
    (debug:print-info 6 *default-log-port* "(dboard:tabdat-allruns tabdat) has " (length (dboard:tabdat-allruns tabdat)) " runs")
    maxtests))

(define *collapsed* (make-hash-table))


(define (toggle-hide lnum uidat) ; fulltestname)
  (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum))
	 (fulltestname (iup:attribute btn "TITLE"))
	 (parts        (string-split fulltestname "("))
	 (basetestname (if (null? parts) "" (car parts))))
					;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
    (if (hash-table-ref/default *collapsed* basetestname #f)
	(begin
︙︙
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648

					; #:image img1
					; #:impress img2
				 #:size "x15"
				 #:expand "HORIZONTAL"
				 #:fontsize "10"
				 #:action (lambda (obj)
					    (mark-for-update tabdat)
					    (toggle-hide testnum))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; 
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))








|








1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651

					; #:image img1
					; #:impress img2
				 #:size "x15"
				 #:expand "HORIZONTAL"
				 #:fontsize "10"
				 #:action (lambda (obj)
					    (mark-for-update tabdat)
					    (toggle-hide testnum uidat))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; 
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))
︙︙
1803
1804
1805
1806
1807
1808
1809
1810

1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895

     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:run-update x commondat)
  (let* ((tabdat          (dboard:common-get-tabdat commondat)) ;; uses curr-tab-num

	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (modtime         (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! 
	 (monitor-modtime (if (file-exists? monitor-db-path)
			      (file-modification-time monitor-db-path)
			      -1))
	 (run-update-time (current-seconds))

	 (recalc          (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat))))
    (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0)
	     (or (> monitor-modtime *last-monitor-update-time*)
		 (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
	(begin
	  (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
	  (if dashboard:update-servers-table (dashboard:update-servers-table))))
    (if recalc
	(begin	
	  (case (dboard:commondat-curr-tab-num commondat) 
	    ((0) 
	     (if dashboard:update-summary-tab (dashboard:update-summary-tab)))
	    ((1) ;; The runs table is active
	     (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
			    (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			    ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			    (let ((res '()))
			      (for-each (lambda (key)
					  (if (not (equal? key "runname"))
					      (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
						(if val (set! res (cons (list key val) res))))))
					(dboard:tabdat-dbkeys tabdat))
			      res))
	     (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
	    ((2)
	     (dashboard:update-run-summary-tab))
	    ((3)
	     (dashboard:update-new-view-tab))
	    (else
	     (let ((updater (dboard:common-get-tabdat commondat)))
	       (if updater (updater)))))
	  (dboard:commondat-please-update-set! commondat #f)
	  (dboard:tabdat-last-db-update-set! tabdat modtime)
	  (set! *last-recalc-ended-time* (current-milliseconds))))))

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

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (common:exit-on-version-changed)
  (let* (;; (runs-dat     (dboard:tabdat-make-data))
	 ;; (runs-sum-dat (dboard:tabdat-make-data)) ;; init (make-d:data))) ;; data for run-summary tab
	 ;; (new-view-dat (dboard:tabdat-make-data)) ;; (dboard:tabdat-make-data)) ;; init (make-d:data)))
	 (commondat       (dboard:commondat-make)))
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
    ;; (dboard:tabdat-last-db-update-set! tabdat (file-modification-time (dboard:tabdat-dbfpath tabdat))) ;; (conc *toppath* "/db/main.db")))
    ;; (set! *monitor-db-path* (conc (dboard:commondat-dbdir commondat) "/monitor.db"))
    (cond 
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))
	     (run-id  (car dat))
	     (test-id (cadr dat)))
	(if (and (number? run-id)
		 (number? test-id)
		 (>= test-id 0))
	    (examine-test run-id test-id)
	    (begin
	      (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
	      (exit 1)))))
     ;; ((args:get-arg "-guimonitor")
     ;;  (gui-monitor (dboard:tabdat-dblocal tabdat)))
     (else
      (set! uidat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
					  ;; (dboard:tabdat-numruns tabdat)
					  ;; (dboard:tabdat-num-tests tabdat)
					  ;; (dboard:tabdat-dbkeys tabdat)
					  ;; runs-sum-dat new-view-dat))
      (iup:callback-set! *tim*
			 "ACTION_CB"
			 (lambda (x)








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












<
<
<
|

<
<


















|








1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867



1868
1869


1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895

     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:run-update x commondat)
  (let* ((tabdat          (dboard:common-get-tabdat commondat))) ;; uses curr-tab-num
    (if tabdat ;; if there is no tabdat then likely we are in a test control panel, no update calls needed
	(let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	       (modtime         (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! 
	       (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
				    (file-modification-time monitor-db-path)
				    -1))
	       (run-update-time (current-seconds))
	       (uidat           (dboard:commondat-uidat commondat))
	       (recalc          (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat))))
	  (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0)
		   (or (> monitor-modtime *last-monitor-update-time*)
		       (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
	      (begin
		(set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
		(if dashboard:update-servers-table (dashboard:update-servers-table))))
	  (if recalc
	      (begin	
		(case (dboard:commondat-curr-tab-num commondat) 
		  ((0) 
		   (if dashboard:update-summary-tab (dashboard:update-summary-tab)))
		  ((1) ;; The runs table is active
		   (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
				  (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
				  ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
				  (let ((res '()))
				    (for-each (lambda (key)
						(if (not (equal? key "runname"))
						    (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
						      (if val (set! res (cons (list key val) res))))))
					      (dboard:tabdat-dbkeys tabdat))
				    res))
		   (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
		  ((2)
		   (dashboard:update-run-summary-tab))
		  ((3)
		   (dashboard:update-new-view-tab))
		  (else
		   (let ((updater (dboard:common-get-tabdat commondat)))
		     (if updater (updater)))))
		(dboard:commondat-please-update-set! commondat #f)
		(dboard:tabdat-last-db-update-set! tabdat modtime)
		(set! *last-recalc-ended-time* (current-milliseconds))))))))

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

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (common:exit-on-version-changed)



  (let* ((commondat       (dboard:commondat-make)))
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...


    (cond 
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))
	     (run-id  (car dat))
	     (test-id (cadr dat)))
	(if (and (number? run-id)
		 (number? test-id)
		 (>= test-id 0))
	    (examine-test run-id test-id)
	    (begin
	      (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
	      (exit 1)))))
     ;; ((args:get-arg "-guimonitor")
     ;;  (gui-monitor (dboard:tabdat-dblocal tabdat)))
     (else
      (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
					  ;; (dboard:tabdat-numruns tabdat)
					  ;; (dboard:tabdat-num-tests tabdat)
					  ;; (dboard:tabdat-dbkeys tabdat)
					  ;; runs-sum-dat new-view-dat))
      (iup:callback-set! *tim*
			 "ACTION_CB"
			 (lambda (x)
︙︙

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