| ︙ | | |
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
+
-
+
+
|
please-update: #t
update-mutex: (make-mutex)
updaters: (make-hash-table)
updating: #f
hide-not-hide-tabs: #f
))
;; RA => returns the value of curr-tab-num for the tabdats in commondats otherwise #f is NULL
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
(hash-table-ref/default
(dboard:commondat-tabdats commondat)
(or tab-num (dboard:commondat-curr-tab-num commondat))
(or tab-num (dboard:commondat-curr-tab-num commondat)) ;; tab-num value is curr-tab-num value in passed commondat
#f))
;; RA => Sets the value of tabnum in commondat-tabdats to tabdat
(define (dboard:common-set-tabdat! commondat tabnum tabdat)
(hash-table-set!
(dboard:commondat-tabdats commondat)
tabnum
tabdat))
;; gets and calls updater based on curr-tab-num
|
| ︙ | | |
851
852
853
854
855
856
857
858
859
860
861
862
863
864
|
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
|
+
|
(color (car (gutils:get-color-for-state-status teststate teststatus)))
(curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
(curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
(if (not (equal? curr-color color))
(iup:attribute-set! button "BGCOLOR" color))
(if (not (equal? curr-title buttontxt))
(iup:attribute-set! button "TITLE" buttontxt))
;;(print "RA => testdat " testdat " teststate " teststate " teststatus " teststatus " buttondat " buttondat " curr-color " curr-color " curr-title " curr-title "buttontxt" buttontxt " title " curr-title )
(vector-set! buttondat 0 run-id)
(vector-set! buttondat 1 color)
(vector-set! buttondat 2 buttontxt)
(vector-set! buttondat 3 testdat)
(vector-set! buttondat 4 run-key)))
(set! rown (+ rown 1))))
(dboard:tabdat-all-test-names tabdat)))
|
| ︙ | | |
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
|
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
|
-
+
|
(let* ((tb (iup:treebox
#:value 0
#:name "Runs"
#:expand "YES"
#:addexpanded "NO"
#:selection-cb
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(print "RA => obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id tabdat (cdr run-path))))
(if (number? run-id)
(begin
(dboard:tabdat-curr-run-id-set! tabdat run-id)
(dboard:tabdat-layout-update-ok-set! tabdat #f)
;; (dashboard:update-run-summary-tab)
|
| ︙ | | |
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
|
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
|
-
+
+
+
+
+
+
+
+
+
+
|
(iup:menu-item
"Clean Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "))))))
" -testpatt % "))))
(iup:menu-item
"Kill Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt % "
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))))
(iup:menu-item
"Test"
(iup:menu
(iup:menu-item
(conc "Rerun " test-name)
#:action
(lambda (obj)
|
| ︙ | | |
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
|
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
|
-
+
|
" " tconfig " &")))
(system cmd))))
))))
(define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat)
(let* ((stats-dat (dboard:tabdat-make-data))
(runs-dat (dboard:tabdat-make-data))
(onerun-dat (dboard:tabdat-make-data))
(onerun-dat (dboard:tabdat-make-data)) ;; name for run-summary structure
(runcontrols-dat (dboard:tabdat-make-data))
(runtimes-dat (dboard:tabdat-make-data))
(nruns (dboard:tabdat-numruns runs-dat))
(ntests (dboard:tabdat-num-tests runs-dat))
(keynames (dboard:tabdat-dbkeys runs-dat))
(nkeys (length keynames))
(runsvec (make-vector nruns))
|
| ︙ | | |
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
|
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
|
+
|
(debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater"))))
(define (dashboard:runs-tab-updater commondat tab-num)
(debug:catch-and-dump
(lambda ()
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
(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* ((dbkeys (dboard:tabdat-dbkeys tabdat)))
;; (print "dbkeys: " dbkeys)
|
| ︙ | | |
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
|
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
|
+
|
(let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
(if val (set! res (cons (list key val) res))))))
dbkeys)
res))))
;; (debug:print 0 *default-log-port* "fres: " fres)
fres)))
(let ((uidat (dboard:commondat-uidat commondat)))
;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat)
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
"dashboard:runs-tab-updater"))
;; ((2)
;; (dashboard:update-run-summary-tab))
;; ((3)
|
| ︙ | | |