Megatest

Diff
Login

Differences From Artifact [c5b55537e1]:

To Artifact [4da921bbb0]:


12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26







-
+







(use format)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 defstruct sparse-vectors)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))

(declare (uses common))
(declare (uses margs))
(declare (uses keys))
(declare (uses items))
(declare (uses db))
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
218
219





















220
221
222
223
224
225
226
227






228
229
230

231
232
233
234


235
236
237
238
239
240



241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257

258
259
260
261
262


263
264
265


266
267
268
269



270
271
272
273


274
275
276
277
278

279
280
281
282
283
284





285
286

287
288
289
290
291
292
293






294
295
296
297

298
299
300
301
302
303
304
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
218
219






220
221
222
223
224
225
226
227

228
229
230


231
232
233
234




235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

254





255
256



257
258




259
260
261




262
263





264






265
266
267
268
269


270







271
272
273
274
275
276




277
278
279
280
281
282
283
284







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


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


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


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


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


-
+


-
-
+
+


-
-
-
-
+
+
+
















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







		     tnum
		     (cons updater curr-updaters))))

;; data for each specific tab goes here
;;
(defstruct dboard:tabdat 
  ;; runs
  allruns          ;; list of dboard:rundat records
  allruns-by-id    ;; hash of run-id -> dboard:rundat records
  done-runs        ;; list of runs already drawn
  not-done-runs    ;; list of runs not yet drawn
  header           ;; header for decoding the run records
  keys             ;; keys for this run (i.e. target components)
  numruns
  tot-runs
  last-data-update ;; last time the data in allruns was updated
  runs-mutex       ;; use to prevent parallel access to draw objects
  ((allruns         '())                 : list)        ;; list of dboard:rundat records
  ((allruns-by-id    (make-hash-table))  : hash-table)  ;; hash of run-id -> dboard:rundat records
  ((done-runs       '())                 : list)        ;; list of runs already drawn
  ((not-done-runs   '())                 : list)        ;; list of runs not yet drawn
  (header            #f)                                ;; header for decoding the run records
  (keys              #f)                                ;; keys for this run (i.e. target components)
  ((numruns          16)                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects

  ;; Runs view
  buttondat 
  item-test-names
  run-keys
  runs-matrix       ;; used in newdashboard
  start-run-offset  ;; left-right slider value
  start-test-offset ;; up-down slider value
  ((buttondat         (make-hash-table)) : hash-table)  ;;     
  ((item-test-names  '())                : list)        
  ((run-keys          (make-hash-table)) : hash-table)
  (runs-matrix        #f)                               ;; used in newdashboard
  ((start-run-offset   0)                : number)      ;; left-right slider value
  ((start-test-offset  0)                : number)      ;; up-down slider value

  ;; Canvas and drawing data
  cnv
  cnv-obj
  drawing
  (cnv                #f)
  (cnv-obj            #f)
  (drawing            #f)
  draw-cache     ;; 
  start-row
  run-start-row
  max-row
  running-layout
  originx
  originy
  layout-update-ok
  compact-layout
  ((run-start-row     0)                 : number)
  ((max-row           0)                 : number)
  ((running-layout    #f)                : boolean)
  (originx            #f)
  (originy            #f)
  ((layout-update-ok  #t)                : boolean)
  ((compact-layout    #t)                : boolean)

  ;; Controls used to launch runs etc.
  command          ;; for run control this is the command being built up
  command-tb 
  key-listboxes
  key-lbs           
  run-name         ;; from run name setting widget
  states           ;; states for -state s1,s2 ...
  statuses         ;; statuses for -status s1,s2 ...

  ;; Selector variables
  curr-run-id      ;; current row to display in Run summary view
  curr-test-ids    ;; used only in dcommon:run-update which is used in newdashboard
  filters-changed  ;; to to indicate that the user changed filters for this tab
  last-filter-str  ;; conc the target runname and testpatt for a signature of changed filters
  hide-empty-runs
  hide-not-hide    ;; toggle for hide/not hide empty runs
  hide-not-hide-button
  searchpatts
  state-ignore-hash    ;; hash of  STATE => #t/#f for display control
  status-ignore-hash   ;; hash of STATUS => #t/#f
  target
  test-patts
  ((command          "")                 : string)      ;; for run control this is the command being built up
  (command-tb        #f)			         
  (key-listboxes     #f)			         
  (key-lbs           #f)			         
  run-name                                              ;; from run name setting widget
  states                                                ;; states for -state s1,s2 ...
  statuses                                              ;; statuses for -status s1,s2 ...
						         
  ;; Selector variables				         
  curr-run-id                                           ;; current row to display in Run summary view
  curr-test-ids                                         ;; used only in dcommon:run-update which is used in newdashboard
  ((filters-changed  #f)                 : boolean)     ;; to to indicate that the user changed filters for this tab
  ((last-filter-str  "")                 : string)      ;; conc the target runname and testpatt for a signature of changed filters
  ((hide-empty-runs  #f)                 : boolean)     
  ((hide-not-hide    #t)                 : boolean)     ;; toggle for hide/not hide empty runs
  (hide-not-hide-button #f)
  ((searchpatts      (make-hash-table))  : hash-table)  ;;
  ((state-ignore-hash (make-hash-table)) : hash-table)  ;; hash of  STATE => #t/#f for display control
  ((status-ignore-hash (make-hash-table)) : hash-table)  ;; hash of STATUS => #t/#f
  (target              #f)
  (test-patts          #f)

  ;; db info to file the .db files for the area
  dbdir
  dbfpath
  dbkeys 
  last-db-update  ;; last db file timestamp
  monitor-db-path ;; where to find monitor.db
  ro               ;; is the database read-only?
  (dbdir               #f)
  (dbfpath             #f)
  (dbkeys              #f)
  ((last-db-update     0)                : number)      ;; last db file timestamp
  (monitor-db-path     #f)                              ;; where to find monitor.db
  ro                                                    ;; is the database read-only?

  ;; tests data
  num-tests        ;; total number of tests to show (used in the old runs display)
  ((num-tests          10)               : number)      ;; total number of tests to show (used in the old runs display)

  ;; runs tree
  path-run-ids     ;; path (target / runname) => id
  runs-tree
  ((path-run-ids       (make-hash-table)) : hash-table) ;; path (target / runname) => id
  (runs-tree           #f)

  ;; tab data
  last-update      ;; last time this tab was updated
  view-changed
  xadj             ;; x slider number (if using canvas)
  yadj             ;; y slider number (if using canvas)
  ((view-changed       #t)                : boolean)   
  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)

  tests-tree       ;; used in newdashboard
  )

(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))

(define (dboard:tabdat-test-patts-use vec)    
  (let ((val (dboard:tabdat-test-patts vec)))(if val val "")))

;; additional setters for dboard:data
(define (dboard:tabdat-test-patts-set!-use    vec val)
  (dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val)))

(define (dboard:tabdat-make-data)
  (let ((dat (make-dboard:tabdat
  (let ((dat (make-dboard:tabdat)))
	      allruns-by-id:        (make-hash-table)
	      allruns:              '() ;; list of run records (vectors)
	      buttondat:            (make-hash-table)
	      curr-test-ids:        (make-hash-table)
	      command:              ""
    ;; 	      curr-test-ids:        (make-hash-table)
    ;; 	      command:              ""
	      compact-layout:       #t
	      dbdir:                #f
	      filters-changed:      #f
    ;; 	      dbdir:                #f
    ;; 	      filters-changed:      #f
	      header:               #f 
	      hide-empty-runs:      #f
	      hide-not-hide-button: #f
	      hide-not-hide:        #t
    ;; 	      hide-empty-runs:      #f
    ;; 	      hide-not-hide-button: #f
    ;; 	      hide-not-hide:        #t
	      item-test-names:      '()
	      keys:                 #f
	      key-listboxes:        #f
	      last-db-update:       0
    ;; 	      key-listboxes:        #f
    ;; 	      last-db-update:       0
	      last-data-update:     0
	      layout-update-ok:     #t
	      not-done-runs:        '()
	      done-runs:            '()
	      num-tests:            15
    ;; 	      num-tests:            15
	      numruns:              16
	      originx:              #f
	      originy:              #f
	      path-run-ids:         (make-hash-table)
	      run-ids:              (make-hash-table)
	      run-keys:             (make-hash-table)
    ;; 	      originx:              #f
    ;; 	      originy:              #f
    ;; 	      path-run-ids:         (make-hash-table)
    ;; 	      run-ids:              (make-hash-table)
    ;; 	      run-keys:             (make-hash-table)
	      running-layout:       #f
	      searchpatts:          (make-hash-table)
    ;; 	      searchpatts:          (make-hash-table)
	      start-run-offset:     0
	      start-test-offset:    0
	      state-ignore-hash:    (make-hash-table)
	      status-ignore-hash:   (make-hash-table)
	      xadj:                 0
	      yadj:                 0
	      view-changed:         #t
    ;; 	      start-test-offset:    0
    ;; 	      state-ignore-hash:    (make-hash-table)
    ;; 	      status-ignore-hash:   (make-hash-table)
    ;; 	      xadj:                 0
    ;; 	      yadj:                 0
    ;; 	      view-changed:         #t
	      run-start-row:        0
	      max-row:              0
	      runs-mutex:           (make-mutex)
	      )))
    ;; 	      )))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))

(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0))
519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+







	 (run-dat    (let ((rec (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)))
			(if rec 
			    rec
			    (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
			      (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
			      rd))))
	 ;; (prev-tests  (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
	 (last-update (dboard:tabdat-last-update tabdat)) ;; (vector-ref prev-dat 3))
	 (last-update (dboard:rundat-last-update run-dat)) ;; (vector-ref prev-dat 3))
	 (tmptests    (rmt:get-tests-for-run run-id testnamepatt states statuses  ;; run-id testpatt states statuses
					     #f #f                                ;; offset limit 
					     (dboard:tabdat-hide-not-hide tabdat) ;; no-in
					     sort-by                              ;; sort-by
					     sort-order                           ;; sort-order
					     #f ;; 'shortlist                           ;; qrytype
					     (if (dboard:tabdat-filters-changed tabdat)