Overview
Context
Changes
Modified dashboard.scm
from [565f2bd4aa]
to [ff610812c0].
︙ | | |
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
|
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; S U M M A R Y
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary)
(let ((rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string)))
(iup:vbox
(iup:frame
#:title "General Info"
(iup:hbox
(dcommon:general-info)
(dcommon:keys-matrix rawconfig))
(dcommon:section-matrix rawconfig "setup" "Varname" "Value")
(dcommon:run-stats))))
(iup:hbox
(dcommon:general-info)
(dcommon:keys-matrix rawconfig)))
(iup:frame
#:title "Megatest config settings"
(iup:hbox
(dcommon:section-matrix rawconfig "setup" "Varname" "Value")
(iup:vbox
(dcommon:section-matrix rawconfig "server" "Varname" "Value")
;; (iup:frame
;; #:title "Disks Areas"
(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
(iup:frame
#:title "Run statistics"
(dcommon:run-stats)))))
;;======================================================================
;; R U N S
;;======================================================================
(define (make-dashboard-buttons nruns ntests keynames)
(let* ((nkeys (length keynames))
|
︙ | | |
Modified db.scm
from [15ecc35fb6]
to [572d71d91a].
︙ | | |
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
|
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
|
+
-
+
+
-
+
+
+
+
|
numruns))
;; get some basic run stats
;;
;; ( (runname (( state count ) ... ))
;; ( ...
(define (db:get-run-stats db)
(let ((totals (make-hash-table))
(let ((res '()))
(res '()))
(sqlite3:for-each-row
(lambda (runname state count)
(hash-table-set! totals state (+ (hash-table-ref/default totals state 0) count))
(set! res (cons (list runname state count) res)))
db
"SELECT runname,t.state,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY t.state,runname;" )
"SELECT runname,t.state||'/'||t.status AS s,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY s,runname;" )
(for-each (lambda (state)
(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
(hash-table-keys totals))
res))
;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
|
︙ | | |
Modified dcommon.scm
from [7faf98a5d2]
to [edf30f9368].
︙ | | |
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
-
+
-
+
|
;; Table of keys
(define (dcommon:keys-matrix rawconfig)
(let* ((curr-row-num 1)
(key-vals (configf:section-vars rawconfig "fields"))
(keys-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "HORIZONTAL" ;; "VERTICAL"
#:expand "YES" ;; "HORIZONTAL" ;; "VERTICAL"
;; #:scrollbar "YES"
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible 5
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "0:1" "Key Name")
(iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
|
︙ | | |
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
-
+
-
+
-
+
+
-
+
|
;; Section to table
(define (dcommon:section-matrix rawconfig sectionname varcolname valcolname #!key (title #f))
(let* ((curr-row-num 1)
(key-vals (configf:section-vars rawconfig sectionname))
(section-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "HORIZONTAL" ;; "YES"
#:expand "YES" ;; "HORIZONTAL"
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible 5
#:numlin-visible (length key-vals)
#:scrollbar "YES")))
(iup:attribute-set! section-matrix "0:0" varcolname)
(iup:attribute-set! section-matrix "0:1" valcolname)
(iup:attribute-set! section-matrix "WIDTH1" "300")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
(iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
key-vals)
(iup:vbox
(iup:label (if title title (conc "Settings from [" sectionname "]"))
#:size "5x"
#:expand "HORIZONTAL")
#:expand "HORIZONTAL"
)
section-matrix)))
;; General data
;;
(define (dcommon:general-info)
(let ((general-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "HORIZONTAL" ;; "YES"
#:expand "YES" ;; "HORIZONTAL"
#:numcol 1
#:numlin 3
#:numcol-visible 1
#:numlin-visible 3)))
(iup:attribute-set! general-matrix "WIDTH1" "300")
(iup:attribute-set! general-matrix "0:1" "About this Megatest area")
;; User (this is not always obvious - it is common to run as a different user
|
︙ | | |
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
+
-
+
-
+
-
+
|
general-matrix))
(define (dcommon:run-stats)
(let* ((run-stats (mt:get-run-stats))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(max-row (apply max (map cadr (car indices))))
(max-col (apply max (map cadr (cadr indices))))
(max-visible (max (- *num-tests* 15) 3))
(stats-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "HORIZONTAL"
#:expand "YES" ;; "HORIZONTAL"
#:numcol max-col
#:numlin (if (< max-row 20) 20 max-row) ;; min of 20
#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
#:numcol-visible max-col
#:numlin-visible (if (> max-row 20) 20 max-row)))
#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
(numrows 1)
(numcols 1)
(set-cell (lambda (rnum cnum rname cname v) ;; rownum colnum value
(print "proc called: " rnum " " cnum " " rname " " cname " " v)
(if (> rnum numrows)
(begin
;; add rows numrows to r
|
︙ | | |