Megatest

Check-in [f84e5af141]
Login
Overview
Comment:Dashboard tabs only update if active to save cycles
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: f84e5af14192c4b3e7dc6fd139122367577c8c3c
User & Date: mrwellan on 2013-07-03 17:22:28
Other Links: branch diff | manifest | tags
Context
2013-07-03
17:26
Dashboard tabs only update if active to save cycles check-in: c59a49651e user: mrwellan tags: dev
17:22
Dashboard tabs only update if active to save cycles check-in: f84e5af141 user: mrwellan tags: dev
11:57
Fixed timestamp on run registration. check-in: 8f0c8da91f user: mrwellan tags: dev
Changes

Modified dashboard.scm from [ff610812c0] to [8221068fa2].

133
134
135
136
137
138
139


140
141
142
143
144
145
146
(define *delayed-update* 0)

(define *db-file-path* (conc *toppath* "/megatest.db"))

(define *tests-sort-reverse* #f)
(define *hide-empty-runs* #f)



(debug:setup)

(define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))







>
>







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
(define *delayed-update* 0)

(define *db-file-path* (conc *toppath* "/megatest.db"))

(define *tests-sort-reverse* #f)
(define *hide-empty-runs* #f)

(define *current-tab-number* 0)

(debug:setup)

(define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859


860
861
862
863

864
865
866
867
868
869
870
						    (system cmd))))))
	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
	  (vector-set! testvec testnum butn)
	  (loop runnum (+ testnum 1) testvec (cons butn res))))))
    ;; now assemble the hdrlst and bdylst and kick off the dialog
    (iup:show
     (iup:dialog 
      #:title (conc "Megatest dashboard " *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (apply iup:hbox 
				(cons (apply iup:vbox lftlst)
				      (list 
				       (iup:vbox
					;; the header
					(apply iup:hbox (reverse hdrlst))
					(apply iup:hbox (reverse bdylst))))))
			 controls))
	     (tabs (iup:tabs


		    (dashboard:summary)
		    runs-view
		    (dashboard:run-controls)
		    )))

	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")
	(iup:attribute-set! tabs "TABTITLE2" "Run Control")
	tabs)))
     (vector keycol lftcol header runsvec)))

(if (or (args:get-arg "-rows")







|











>
>




>







843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
						    (system cmd))))))
	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
	  (vector-set! testvec testnum butn)
	  (loop runnum (+ testnum 1) testvec (cons butn res))))))
    ;; now assemble the hdrlst and bdylst and kick off the dialog
    (iup:show
     (iup:dialog 
      #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (apply iup:hbox 
				(cons (apply iup:vbox lftlst)
				      (list 
				       (iup:vbox
					;; the header
					(apply iup:hbox (reverse hdrlst))
					(apply iup:hbox (reverse bdylst))))))
			 controls))
	     (tabs (iup:tabs
		    #:tabchangepos-cb (lambda (obj curr prev)
					(set! *current-tab-number* curr))
		    (dashboard:summary)
		    runs-view
		    (dashboard:run-controls)
		    )))
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")
	(iup:attribute-set! tabs "TABTITLE2" "Run Control")
	tabs)))
     (vector keycol lftcol header runsvec)))

(if (or (args:get-arg "-rows")
887
888
889
890
891
892
893


894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
(define (dashboard:been-changed)
  (> (file-modification-time (conc *toppath* "/megatest.db")) *last-db-update-time*))

(define (dashboard:set-db-update-time)
  (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))))

(define (dashboard:run-update x)


  (update-buttons uidat *num-runs* *num-tests*)
  ;; (if (dashboard:been-changed)
  (begin
    (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
		   (hash-table-ref/default *searchpatts* "test-name" "%/%")
		   ;; (hash-table-ref/default *searchpatts* "item-name" "%")
		   (let ((res '()))
		     (for-each (lambda (key)
				 (if (not (equal? key "runname"))
				     (let ((val (hash-table-ref/default *searchpatts* key #f)))
				       (if val (set! res (cons (list key val) res))))))
			       *dbkeys*)
		     res))
    ; (dashboard:set-db-update-time)
    ))

(cond 
 ((args:get-arg "-run")
  (let ((runid (string->number (args:get-arg "-run"))))
    (if runid
	(begin
	  (lambda (x)







>
>
|
<
<
|
|
|
|
|
|
|
|
|
<
|
|







892
893
894
895
896
897
898
899
900
901


902
903
904
905
906
907
908
909
910

911
912
913
914
915
916
917
918
919
(define (dashboard:been-changed)
  (> (file-modification-time (conc *toppath* "/megatest.db")) *last-db-update-time*))

(define (dashboard:set-db-update-time)
  (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))))

(define (dashboard:run-update x)
  (case *current-tab-number* 
    ((1) ;; The runs table is active
     (update-buttons uidat *num-runs* *num-tests*)


     (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
		    (hash-table-ref/default *searchpatts* "test-name" "%/%")
		    ;; (hash-table-ref/default *searchpatts* "item-name" "%")
		    (let ((res '()))
		      (for-each (lambda (key)
				  (if (not (equal? key "runname"))
				      (let ((val (hash-table-ref/default *searchpatts* key #f)))
					(if val (set! res (cons (list key val) res))))))
				*dbkeys*)

		      res)) ;; (dashboard:set-db-update-time)
     )))

(cond 
 ((args:get-arg "-run")
  (let ((runid (string->number (args:get-arg "-run"))))
    (if runid
	(begin
	  (lambda (x)

Modified dcommon.scm from [5dfda65184] to [26cee9e3e3].

106
107
108
109
110
111
112


113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145




146
147
148
149
150
151

152
153
154
155
156
157

158
159
160
161
162
163
164
165
166


167
168
169
170
171
172
173
    (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)
	 (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
			       (debug:print 0 "Extending matrix from " numrows " to " rnum)
			       (iup:attribute-set! stats-matrix  "ADDLIN" (conc numrows "-" (- rnum numrows)))
			       (set! numrows rnum)))
			 (if (> cnum numcols)
			     (begin 
			       ;; add rows numrows to r
			       (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
    (for-each (lambda (ind)
		(let ((name (car ind))
		      (num  (cadr ind)))
		  (iup:attribute-set! stats-matrix (conc "0:" num) name)))
	      col-indices)

    ;; Cell contents
    (for-each (lambda (entry)
		(let* ((row-name (car entry))
		       (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)







>
>
|
|
|
|
|
<
<
<
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
|
|
|
|
|
|
>
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
>
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    (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* ((stats-matrix (iup:matrix expand: "YES"))
	 (updater      (lambda ()
			 (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))







				(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
						      (debug:print 0 "Extending matrix from " numrows " to " rnum)
						      (iup:attribute-set! stats-matrix  "ADDLIN" (conc numrows "-" (- rnum numrows)))
						      (set! numrows rnum)))
						(if (> cnum numcols)
						    (begin 
						      ;; add rows numrows to r
						      (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 "NUMCOL" max-col )
			   (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20
			   (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col)
			   (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))

			   ;; 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
			   (for-each (lambda (ind)
				       (let ((name (car ind))
					     (num  (cadr ind)))
					 (iup:attribute-set! stats-matrix (conc "0:" num) name)))
				     col-indices)

			   ;; Cell contents
			   (for-each (lambda (entry)
				       (let* ((row-name (car entry))
					      (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)))))
    (updater)
    (iup:attribute-set! stats-matrix "WIDTHDEF" "40")
    (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)