Megatest

Check-in [c9f0aef620]
Login
Overview
Comment:Improved info page layout
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: c9f0aef620f38f4e99c9c8ca5cdeb3cd6cc333e2
User & Date: mrwellan on 2013-07-02 11:00:06
Other Links: branch diff | manifest | tags
Context
2013-07-02
16:28
Improved info page layout check-in: 0d67b603e1 user: mrwellan tags: dev
11:00
Improved info page layout check-in: c9f0aef620 user: mrwellan tags: dev
00:35
Oops, dropped new file check-in: 79e9017edb user: mrwellan tags: dev
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