Megatest

Check-in [422ec08c45]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Display basics for areas
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 422ec08c45db9a243cf4593dbd7dcc234988a473
User & Date: matt on 2015-06-29 00:18:05
Other Links: branch diff | manifest | tags
Context
2015-06-29
17:44
Partial re-work of test status rollup for itemized tests. Initial implementation of per test summary generation check-in: e9a41f7443 user: mrwellan tags: v1.60
00:18
Display basics for areas check-in: 422ec08c45 user: matt tags: v1.60
2015-06-25
00:15
Added reading of test data check-in: eaf10c5502 user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified multi-dboard.scm from [c64710092d] to [a922f9abf1].

︙
177
178
179
180
181
182
183


184
185
186
187
188
189
190

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192








+
+








  view-type ;; standard, etc.
  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters, alist name -> filter record, eventually store these in ~/.megatest/<group>.dat?
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field
  headers   ;; hash of header  -> colnum
  rows      ;; hash of rowname -> rownum
  )

(define-record filter
  target    ;; hash of widgets for the target
  runname   ;; the runname widget
  testpatt  ;; the testpatt widget
  )
︙
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313



















314




315
316
317
318
319
320
321

300
301
302
303
304
305
306









307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337








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

+
+
+
+









;; initialize and refresh data
;;		
(define (dboard:general-updater con port)
  (for-each
   (lambda (window-id)
     ;; (print "Processing for window-id " window-id)
     (let* ((window-dat   (hash-table-ref *windows* window-id))
	    (areas        (data-areas     window-dat))
	    (tabs         (data-tabs      window-dat))
	    (tab-ids      (hash-table-keys tabs))
	    (current-tab  (if (null? tab-ids)
			      #f
			      (hash-table-ref tabs (car tab-ids))))
	    (current-tree (if (null? tab-ids) #f (tab-tree current-tab)))
	    (seen-nodes   (make-hash-table)))
     (let* ((window-dat     (hash-table-ref *windows* window-id))
	    (areas          (data-areas     window-dat))
	    ;; (keys           (areadat-run-keys area-dat))
	    (tabs           (data-tabs      window-dat))
	    (tab-ids        (hash-table-keys tabs))
	    (current-tab    (if (null? tab-ids)
				#f
				(hash-table-ref tabs (car tab-ids))))
	    (current-tree   (if (null? tab-ids) #f (tab-tree   current-tab)))
	    (current-node   (if (null? tab-ids) 0  (string->number (iup:attribute current-tree "VALUE"))))
	    (current-path   (if (eq? current-node 0)
				"Areas"
				(string-intersperse (tree:node->path current-tree current-node) "/")))
	    (current-matrix (if (null? tab-ids) #f (tab-matrix current-tab)))
	    (seen-nodes     (make-hash-table))
	    (path-changed   (if current-tab
				(equal? current-path (tab-view-path current-tab))
				#t)))
       ;; (debug:print-info 0 "Current path: " current-path)
       ;; now for each area in the window gather the data
       (if path-changed
	   (begin
	     (debug:print-info 0 "clearing matrix - path changed")
	     (dboard:clear-matrix current-tab)))
       (for-each
	(lambda (area-name)
	  ;; (print "Processing for area-name " area-name)
	  (let* ((area-dat  (hash-table-ref areas area-name))
		 (area-path (areadat-path   area-dat))
		 (runs      (areadat-runs   area-dat)))
	    (if (hash-table-ref/default *changed-main* area-path 'processed)
︙
333
334
335
336
337
338
339
340




341
342
343
344
345
346
347

349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366








-
+
+
+
+








				  (full-path    (cons area-name partial-path)))
			     (if (not (hash-table-exists? seen-nodes full-path))
				 (begin
				   (print "INFO: Adding node " partial-path " to section " area-name)
				   (tree:add-node current-tree "Areas" full-path)
				   (areadb:fill-tests area-dat run-ids: (list run-id))))
				   (hash-table-set! seen-nodes full-path #t)))))
		   (hash-table-keys runs))))))
		   (hash-table-keys runs))))
	    (if (or (equal? "Areas" current-path)
		    (string-match (conc "^Areas/" area-name "(|\\/.*)$") current-path))
		(dboard:redraw-area area-name area-dat current-tab current-matrix current-path))))
	(hash-table-keys areas))))
   (hash-table-keys *windows*)))

;;======================================================================
;; D A S H B O A R D   D B 
;;======================================================================
︙
382
383
384
385
386
387
388

389

390
391
392

393
394
395
396
397

398
399
400
401



402
403
404
405
406
407
408





409
410
411
412
413
414
415

401
402
403
404
405
406
407
408

409
410
411
412
413
414
415
416
417

418
419



420
421
422
423
424





425
426
427
428
429
430
431
432
433
434
435
436








+
-
+



+




-
+

-
-
-
+
+
+


-
-
-
-
-
+
+
+
+
+








;;======================================================================
;; M A I N   M A T R I X
;;======================================================================

;; General displayer
;;
(define (dashboard:main-matrix data adat window-id)
  (let* (;; (tab-dat         (areadat-
  (let* ((view-matrix     (iup:matrix
	 (view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:resizematrix "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3
			   #:numlin-visible 20
			   #:click-cb (lambda (obj lin col status)
					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))

    (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
					(print "obj: " obj " lin: " lin " col: " col " status: " status " value: " (iup:attribute obj "VALUE"))))))
    
    ;; (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
    (iup:attribute-set! view-matrix "WIDTH0" "100")
    ;; (dboard:data-set-runs-matrix! *data* runs-matrix)
    (iup:hbox
     (iup:frame 
      #:title "Runs browser"
      (iup:vbox
       view-matrix)))))
    ;; (iup:hbox
    ;;  (iup:frame 
    ;;   #:title "Runs browser"
    ;;   (iup:vbox
    view-matrix))

;;======================================================================
;; A R E A S
;;======================================================================

(define (dashboard:init-area data area-name apath)
  (let* ((mtconf      (dboard:read-mtconf apath))
︙
427
428
429
430
431
432
433





























































434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452

453
454
455
456


457
458
459
460
461
462
463

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541
542
543
544
545
546
547








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
+




+
+








				 #f
				 #f
				 )))
			(hash-table-set! (data-areas data) area-name ad)
			ad)))
    area-dat))

;; given the keys for an area and a path from the tree browser
;; return the level: areas area runs run tests test
;;
(define (dboard:get-view-type keys current-path)
  (let* ((path-parts (string-split current-path "/"))
	 (path-len   (length path-parts)))
    (cond
     ((equal? current-path "Areas")     'areas)
     ((eq? path-len 2)                  'area)
     ((<= (+ (length keys) 2) path-len) 'runs)
     (else                              'run))))

(define (dboard:clear-matrix tab)
  (if tab
      (begin
	(iup:attribute-set! (tab-matrix tab) "CLEARVALUE" "ALL")
	(tab-headers-set! tab (make-hash-table))
	(tab-rows-set!    tab (make-hash-table)))))

;; full redraw of a given area
;;
(define (dboard:redraw-area area-name area-dat tab-dat current-matrix current-path)
  (let* ((keys      (areadat-run-keys area-dat))
	 (runs      (areadat-runs     area-dat))
	 (headers   (tab-headers   tab-dat))
	 (rows      (tab-rows      tab-dat))
	 (used-cols (hash-table-values headers))
	 (used-rows (hash-table-values rows))
	 (touched   (make-hash-table)) ;; (vector row col) ==> true, touched cell
	 (view-type (dboard:get-view-type keys current-path))
	 (changed   #f)
	 (state-statuses  (list "PASS" "FAIL" "WARN" "CHECK" "SKIP" "RUNNING" "LAUNCHED")))
    (debug:print 0 "current-matrix=" current-matrix)
    (case view-type
      ((areas) ;; find row for this area, if not found, create new entry
       (let* ((curr-rownum (hash-table-ref/default rows area-name #f))
	      (next-rownum (+ (apply max (cons 0 used-rows)) 1))
	      (rownum      (or curr-rownum next-rownum))
	      (coord       (conc rownum ":0")))
	 (if (not curr-rownum)(hash-table-set! rows area-name rownum))
	 (if (not (equal? (iup:attribute current-matrix coord) area-name))
	     (begin
	       (let loop ((hed  (car state-statuses))
			  (tal  (cdr state-statuses))
			  (count 1))
		 (if (not (equal? (iup:attribute current-matrix (conc "0:" count)) hed))
		     (iup:attribute-set! current-matrix (conc "0:" count) hed))
		 (iup:attribute-set! current-matrix (conc rownum ":" count) "0")
		 (if (not (null? tal))
		     (loop (car tal)(cdr tal)(+ count 1))))
	       (debug:print-info 0 "view-type=" view-type ", rownum=" rownum ", curr-rownum=" curr-rownum ", next-rownum=" next-rownum ", coord=" coord ", area-name=" area-name)
	       (iup:attribute-set! current-matrix coord area-name)
	       (set! changed #t))))))
    (if changed (iup:attribute-set! current-matrix "REDRAW" "ALL"))))
	     

       
   ;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all
    
	
  
;;======================================================================
;; D A S H B O A R D
;;======================================================================

(define (dashboard:area-panel aname data window-id)
  (let* ((apath      (configf:lookup (data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
	 ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
	 (area-dat   (dashboard:init-area data aname apath))
	 (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
	 (ad         (dashboard:main-matrix  data area-dat window-id))
	 (areas      (data-areas data))
	 (dboard-dat (make-tab
		      #f           ;; tree
		      #f           ;; matrix
		      area-dat     ;;
		      #f           ;; view path
		      'default     ;; view type
		      #f           ;; controls
		      #f           ;; cached data
		      (make-hash-table) ;; cached data? not sure how to use this yet :)
		      #f           ;; filters
		      #f           ;; the run-id
		      (make-hash-table) ;; run-id -> test-id, for current test id
		      ""
		      (make-hash-table) ;; headername -> colnum
		      (make-hash-table) ;; rowname    -> rownum
		      )))
    (hash-table-set! (data-areas data) aname area-dat) ;; dboard-dat)
    (hash-table-set! (data-tabs data) window-id dboard-dat)
    (tab-tree-set!   dboard-dat tb)
    (tab-matrix-set! dboard-dat ad)
    (iup:split
     #:value 200
︙

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