Megatest

Check-in [5a82492081]
Login
Overview
Comment:basic new view updates
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-real-new-runs-view
Files: files | file ages | folders
SHA1: 5a8249208187d9e2a820b247c4eb3b4403df09d6
User & Date: mrwellan on 2021-02-23 10:57:59
Other Links: branch diff | manifest | tags
Context
2021-02-23
21:25
Merged wip branch check-in: 2ba22ca68d user: matt tags: v1.65-real-new-runs-view
20:06
Merged real-new-runs-view check-in: f21ad6e7f5 user: matt tags: v1.65-real-new-runs-view-wip (unpublished)
10:57
basic new view updates check-in: 5a82492081 user: mrwellan tags: v1.65-real-new-runs-view
2021-02-22
23:33
Got crude data on run-tests-matrix check-in: d6715426e7 user: matt tags: v1.65-real-new-runs-view
Changes

Modified dashboard-new-runs-view.scm from [69777e7e2c] to [24de2d2df6].

44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
44
45
46
47
48
49
50

51
52
53
54
55
56
57
58







-
+







    ;; update runs       id              => runrec
    ;; update targ-runid target/runname  => run-id
    (for-each
     (lambda (runrec)
       (let* ((run-id (simple-run-id runrec))
	      (full-targ-runname (conc (simple-run-target runrec) "/"
				       (simple-run-runname runrec))))
	 (debug:print 0 *default-log-port* "Update run  " run-id)
	 ;; (debug:print 0 *default-log-port* "Update run  " run-id)
	 (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
	 (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id)
	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
	 ))
     data)
    numruns))

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
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
177









178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217







-
+






-
+



+
+
+
+
+
+
+
+
+
+





+

+
-
-
+
+

+
+
+
-
+
+
+

-
+

+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	 ;; (itempath-sql-filt    (dboard:rdat-itempath-sql-filt    rdat))
	 (test-state-sql-filt  (dboard:rdat-test-state-sql-filt  rdat))  ;; not used yet
	 (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat))  ;; not used yet
	 (tests                (rmt:get-tests-for-run-state-status run-id
						      testname-sql-filt
						      last-update                ;; last-update
						      )))
    (debug:print 0 *default-log-port* "tests: " tests)
    ;; (debug:print 0 *default-log-port* "tests: " tests)
    (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1))
    (sparse-vector-set! (dboard:rdat-run-tests rdat) run-id
			(delete-duplicates
			 (append tests (sparse-vector-ref (dboard:rdat-run-tests rdat) run-id))
			 (lambda (a b)
			   (eq? (vector-ref a 0)(vector-ref b 0))))) ;; de-duplicate based on test id
    (debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id "
    #;(debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id "
		 run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update
		 " first test info: " tests) ;; (if (not (null? tests))(car tests) '()))
    (length tests)))

;; NB// start at 1.
;;
(define (dashboard:get-row-num mtrx rownames tname)
  (or (hash-table-ref/default rownames tname #f)
      (let* ((numentries (hash-table-size rownames))
	     (nextnum    (+ numentries 1)))
	(hash-table-set! rownames tname nextnum)
	(iup:attribute-set! mtrx (conc nextnum ":0") tname)
	nextnum)))

(define (dashboard:update-new-runs-view-runs-matrix commondat rdat)
  (let* ((run-tests-data (dboard:rdat-run-tests rdat)) ;; from dbmod.scm (define-record simple-run target id runname state status owner event_time)
	 (run-tests-mtx  (dboard:rdat-runs-mtx  rdat))
	 (runs-by-num    (dboard:rdat-runsbynum rdat)) ;; this is the sequence num
	 (num-runs       (vector-length runs-by-num))
	 )
    (debug:print 0 *default-log-port* "num-runs: " num-runs)
    (let loop ((col-num 0))
      (let* ((runrec    (vector-ref runs-by-num col-num))
    (let loop ((col-num 1))
      (let* ((runrec    (vector-ref runs-by-num (- col-num 1)))
	     (run-id    (simple-run-id runrec))
	     (target    (simple-run-target runrec))
	     (runname   (simple-run-runname runrec))
	     (vert-targ (string-translate (conc target "/" runname) "/" "\n"))
	     (run-tests (sparse-vector-ref run-tests-data run-id)))
	     (run-tests (sparse-vector-ref run-tests-data run-id))
	     (changed   #f))  ;; manage redraws on a column by column basis
	(debug:print 0 *default-log-port* "run-tests: " run-tests)
	(if (null? run-tests) ;; empty run
	    (if (< col-num 10) ;; NOT CORRECT
	    (if (< col-num num-runs) ;; NOT CORRECT
		(loop (+ col-num)))
	    (begin
	      (set! changed (dcommon:modifiy-if-different ;; set the col header
			     run-tests-mtx
			     (conc "0:" col-num)
			     vert-targ
			     changed))
	    (let testloop ((row-num 0)
			   (tail    run-tests))
	      (let* ((test-dat (car run-tests))
		     (tname    (db:test-get-testname test-dat)))
		(iup:attribute-set! run-tests-mtx (conc col-num ":" row-num) tname)
		(if (not (null? tail))
		    (testloop (+ row-num 1)(cdr tail))
		    (if (< col-num 10)
			(loop (+ col-num 1))))))))))) 
	      (let testloop ((inum    0)
			     (tail    run-tests))
		(let* ((test-dat   (car tail))
		       (tname      (db:test-get-testname test-dat))
		       (state      (db:test-get-state    test-dat))
		       (status     (db:test-get-status   test-dat))
		       (item-path  (db:test-get-item-path test-dat))
		       (color      (gutils:get-color-for-state-status state status))
		       (is-deleted (equal? state "DELETED"))
		       (row-num    (if is-deleted
				       #f
				       (dashboard:get-row-num run-tests-mtx
							      (dboard:rdat-rownames rdat) tname)))
		       (cell-name (conc row-num ":" col-num)))
		  (if (or (not is-deleted)
			  (equal? item-path ""))
		      (begin
 			(set! changed (dcommon:modifiy-if-different 
 				       run-tests-mtx
 				       (conc "BGCOLOR" row-num ":" col-num)
 				       (car color)
 				       changed))
			(set! changed (dcommon:modifiy-if-different 
 				       run-tests-mtx
 				       cell-name
 				       (cadr color)
 				       changed))))
		  (if (not (null? (cdr tail)))
		      (testloop (+ inum 1)(cdr tail))
		      (begin
			(iup:attribute-set! run-tests-mtx (conc "C" col-num) "REDRAW")
			(if (< col-num num-runs)
			    (loop (+ col-num 1)))))))))))))

(define (dboard:runs-new-matrix commondat rdat)
  (iup:matrix
   #:alignment1 "ALEFT"
   #:expand "YES" ;; "HORIZONTAL"
   #:scrollbar "YES"
   #:numcol 100

Modified dcommonmod.scm from [7f31d1edbb] to [7441aa8866].

190
191
192
193
194
195
196
197


198
199
200
201
202
203
204
190
191
192
193
194
195
196

197
198
199
200
201
202
203
204
205







-
+
+







  (toprow    0) ;; topmost visible row
  (numcols  24) ;; number of columns visible
  (numrows  20) ;; number of rows visible
  
  ;; efactored  <=== merge detritus
  (runs       (make-sparse-vector #f))  ;; id => runrec
  (run-tests  (make-sparse-vector '())) ;; id => list of tests
  (runsbynum  (make-vector 100 #f))     ;; vector num => runrec 
  (runsbynum  (make-vector 100 #f))     ;; vector num => runrec
  (rownames   (make-hash-table))        ;; testname => rownum
  (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

  ;; run sql filters 
  (targ-sql-filt        "%")
  (runname-sql-filt     "%")
  (run-state-sql-filt   "%")