︙ | | |
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
-
-
|
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (unit dcommon))
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses testsmod))
(declare (uses mtargs))
(declare (uses vgmod))
;; (declare (uses vgmod.import))
(declare (uses ezstepsmod))
(declare (uses rmtmod))
(declare (uses subrunmod))
(declare (uses megatestmod))
(declare (uses runsmod))
(declare (uses tasksmod))
(declare (uses dbfile))
|
︙ | | |
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
|
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
|
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
(define (dcommon:runsdat-get-col-num dat target runname force-set)
(let* ((runs-index (dboard:runsdat-runs-index dat))
(col-name (conc target "/" runname))
(res (hash-table-ref/default runs-index col-name #f)))
(if res
res
(if force-set
(let ((max-col-num (+ 1 (common:max (cons-1 (hash-table-values runs-index))))))
(let ((max-col-num (+ 1 (common:max (cons -1 (hash-table-values runs-index))))))
(hash-table-set! runs-index col-name max-col-num)
max-col-num)))))
(define (dcommon:runsdat-get-row-num dat testname itempath force-set)
(let* ((tests-index (dboard:runsdat-runs-index dat))
(row-name (conc testname "/" itempath))
(res (hash-table-ref/default runs-index row-name #f)))
(if res
res
(if force-set
(let ((max-row-num (+ 1 (common:max (cons -1 (hash-table-values tests-index))))))
(hash-table-set! runs-index row-name max-row-num)
max-row-num)))))
;; (define (dcommon:runsdat-get-row-num dat testname itempath force-set)
;; (let* ((tests-index (dboard:runsdat-runs-index dat))
;; (row-name (conc testname "/" itempath))
;; (res (hash-table-ref/default runs-index row-name #f)))
;; (if res
;; res
;; (if force-set
;; (let ((max-row-num (+ 1 (common:max (cons -1 (hash-table-values tests-index))))))
;; (hash-table-set! runs-index row-name max-row-num)
;; max-row-num)))))
(define (dcommon:rundat-copy-tests-to-by-name rundat)
(let ((src-ht (dboard:rundat-tests rundat))
(trg-ht (dboard:rundat-tests-by-name rundat)))
(if (and (hash-table? src-ht)(hash-table? trg-ht))
(begin
(hash-table-clear! trg-ht)
|
︙ | | |
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
|
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
|
-
+
|
#:numcol-visible 7
#:numlin-visible 5
))
(colnames (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId"))
(updater (lambda ()
(if (dashboard:monitor-changed? commondat tabdat)
(let ((servers (case (rmt:transport-mode)
((http)(server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath* limit: 10)))
;; ((http)(server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath* limit: 10)))
(else '()))))
(iup:attribute-set! servers-matrix "NUMLIN" (length servers))
;; (set! colnum 0)
;; (for-each (lambda (colname)
;; ;; (print "colnum: " colnum " colname: " colname)
;; (iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
;; (set! colnum (+ 1 colnum)))
|
︙ | | |
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
|
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
|
+
|
;; data from sql db
(keys (rmt:get-keys)) ;; to be removed when targets handling is refactored
(runs (make-sparse-vector)) ;; id => runrec
(runsbynum (make-vector 100 #f)) ;; vector num => runrec
(targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed
(tests (make-hash-table)) ;; test[/itempath] => list of test rec
(path-run-ids (make-hash-table)) ;; referenced but not set anywhere in new run viewer, maybe get rid of this whole attempt?
;; run sql filters
(targ-sql-filt "%")
(runname-sql-filt "%")
(run-state-sql-filt "%")
(run-status-sql-filt "%")
|
︙ | | |
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
|
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
|
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
|
id ;; testid
state ;; test state
status ;; test status
)
;; default is to NOT set the cell if the column and row names are not pre-existing
;;
(define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f))
(let* ((col-num (dcommon:runsdat-get-col-num dat target runname force-set))
(row-num (dcommon:runsdat-get-row-num dat testname itempath force-set)))
(if (and row-num col-num)
(let ((tdat (make-dboard:testdat
id: test-id
state: state
status: status)))
(sparse-array-set! (dboard:runsdat-matrix-dat dat) col-num row-num tdat)
tdat)
#f)))
;; (define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f))
;; (let* ((col-num (dcommon:runsdat-get-col-num dat target runname force-set))
;; (row-num (dcommon:runsdat-get-row-num dat testname itempath force-set)))
;; (if (and row-num col-num)
;; (let ((tdat (make-dboard:testdat
;; id: test-id
;; state: state
;; status: status)))
;; (sparse-array-set! (dboard:runsdat-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)
|
︙ | | |