Megatest

Check-in [0d67b603e1]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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: 0d67b603e14fbbb3a8b58a7590eee29309110fcb
User & Date: mrwellan on 2013-07-02 16:28:40
Other Links: branch diff | manifest | tags
Context
2013-07-03
11:57
Fixed timestamp on run registration. check-in: 8f0c8da91f user: mrwellan tags: dev
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified db.scm from [572d71d91a] to [e987813ffc].

︙︙
684
685
686
687
688
689
690


691
692
693
694
695
696
697
698
699

;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)
  (let ((totals       (make-hash-table))
	(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||'/'||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))









>
>
|
|








684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701

;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)
  (let ((totals       (make-hash-table))
	(res          '()))
    (sqlite3:for-each-row
     (lambda (runname state count)
       (let* ((stateparts (string-split state "/"))
	      (newstate   (conc (car stateparts) "\n" (cadr stateparts))))
	 (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count))
	 (set! res (cons (list runname newstate count) res))))
     db
    "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))
︙︙

Modified dcommon.scm from [edf30f9368] to [5dfda65184].

︙︙
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

			#:numlin (length key-vals)
			#:numcol-visible 1
			#: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 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
       (iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))








|








41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

			#:numlin (length key-vals)
			#:numcol-visible 1
			#: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 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
       (iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
︙︙
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

			   #:numcol 1
			   #:numlin (length key-vals)
			   #:numcol-visible 1
			   #: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)))








|








66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

			   #:numcol 1
			   #:numlin (length key-vals)
			   #:numcol-visible 1
			   #: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" "200")
    ;; 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)))
︙︙
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #: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
    (iup:attribute-set! general-matrix "1:0" "User")
    (iup:attribute-set! general-matrix "1:1" (current-user-name))
    ;; Megatest area
    (iup:attribute-set! general-matrix "2:0" "Megatest area")
    (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "3:0" "Megatest version")
    (iup:attribute-set! general-matrix "3:1" megatest-version)
    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 "YES" ;; "HORIZONTAL"
			#:numcol max-col 
			#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
			#:numcol-visible max-col
			#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
	 (numrows      1)
	 (numcols      1)








|



















|








92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #:expand "YES" ;; "HORIZONTAL"
			 #:numcol 1
			 #:numlin 3
			 #:numcol-visible 1
			 #:numlin-visible 3)))
    (iup:attribute-set! general-matrix "WIDTH1" "200")
    (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
    (iup:attribute-set! general-matrix "1:0" "User")
    (iup:attribute-set! general-matrix "1:1" (current-user-name))
    ;; Megatest area
    (iup:attribute-set! general-matrix "2:0" "Megatest area")
    (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "3:0" "Megatest version")
    (iup:attribute-set! general-matrix "3:1" megatest-version)
    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 "YES" ;; "HORIZONTAL"
			#:numcol max-col 
			#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
			#:numcol-visible max-col
			#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
	 (numrows      1)
	 (numcols      1)
︙︙
138
139
140
141
142
143
144

145
146
147
148
149
150
151

			       (debug:print 0 "Extending matrix from " numcols " to " cnum)
			       (iup:attribute-set! stats-matrix  "ADDLIN" (conc numcols "-" (- rnum numcols)))
			       (set! numcols cnum)))
			 (debug:print 0 "Setting row " rnum ", col " cnum " to " v)
			 (iup:attribute-set! stats-matrix (conc rnum ":" cnum) v)))
	 (row-indices  (car indices))
	 (col-indices  (cadr indices)))

    ;; Row labels
    (for-each (lambda (ind)
		(let ((name (car ind))
		      (num  (cadr ind)))
		  (iup:attribute-set! stats-matrix (conc num ":0") name)))
	      row-indices)
    ;; Col labels








>








138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

			       (debug:print 0 "Extending matrix from " numcols " to " cnum)
			       (iup:attribute-set! stats-matrix  "ADDLIN" (conc numcols "-" (- rnum numcols)))
			       (set! numcols cnum)))
			 (debug:print 0 "Setting row " rnum ", col " cnum " to " v)
			 (iup:attribute-set! stats-matrix (conc rnum ":" cnum) v)))
	 (row-indices  (car indices))
	 (col-indices  (cadr indices)))
    (iup:attribute-set! stats-matrix "WIDTHDEF" "40")
    ;; Row labels
    (for-each (lambda (ind)
		(let ((name (car ind))
		      (num  (cadr ind)))
		  (iup:attribute-set! stats-matrix (conc num ":0") name)))
	      row-indices)
    ;; Col labels
︙︙
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

		       (col-name (cadr entry))
		       (value    (caddr entry))
		       (row-num  (cadr (assoc row-name row-indices)))
		       (col-num  (cadr (assoc col-name col-indices))))
		  (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value)))
	      run-stats)
    (iup:vbox
     (iup:label "Run statistics" #:expand "HORIZONTAL")
     stats-matrix)))

;; The main menu
(define (dcommon:main-menu)
  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
		       (iup:menu-item "Open"  action: (lambda (obj)








|








161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

		       (col-name (cadr entry))
		       (value    (caddr entry))
		       (row-num  (cadr (assoc row-name row-indices)))
		       (col-num  (cadr (assoc col-name col-indices))))
		  (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value)))
	      run-stats)
    (iup:vbox
     (iup:label "Run statistics"  #:expand "HORIZONTAL")
     stats-matrix)))

;; The main menu
(define (dcommon:main-menu)
  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
		       (iup:menu-item "Open"  action: (lambda (obj)
︙︙

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