Megatest

Changes On Branch 948b48ab12aa919f
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Unified Diff

Changes In Branch db-new Through [948b48ab12] Excluding Merge-Ins

This is equivalent to a diff from c449bba35a to 948b48ab12

2016-11-30
17:01
Filter working check-in: d9859999af user: ritikaag tags: db-new
2016-11-14
13:55
Show button functionality check-in: 948b48ab12 user: ritikaag tags: db-new
10:36
Fixed spelling and added comment check-in: 3438d7c75e user: mrwellan tags: db-new
2016-10-27
15:13
Merged with latest and run tab fix check-in: 28bf2c1d25 user: ritikaag tags: db-new
2016-10-25
21:02
fixed -list-servers and -stop-server switches on megatest check-in: 73502a1626 user: bjbarcla tags: v1.62
10:37
Updated plans check-in: c449bba35a user: mrwellan tags: v1.62
2016-10-24
13:24
Added info on dashboard look controls check-in: 68a8e2b689 user: mrwellan tags: v1.62

Modified dashboard.scm from [929e1f3c0c] to [dae6ad3930].

︙︙
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270

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

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

  ;; tab data
  ((view-changed       #t)                : boolean)   

  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)








|
>








256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

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

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

  ;; tab data
  ((view-changed       #t)                : boolean)
  ((rebuild-dwg        #t)                : boolean)
  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)
︙︙
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271

1272
1273
1274
1275
1276
1277
1278

					  (lambda ()
					    (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))
					    (dashboard:update-run-command tabdat))
					  "command-testname-selector tb action"))
			      #:value (dboard:test-patt->lines
				       (dboard:tabdat-test-patts-use tabdat))
			      #:expand "HORIZONTAL"
			      ;; #:size "10x30"
			      ))
	 (tb
          (iup:treebox
           #:value 0
           #:name "Runs"
           #:expand "YES"
           #:addexpanded "NO"

           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (tree-path->run-id tabdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number








<







>








1258
1259
1260
1261
1262
1263
1264

1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279

					  (lambda ()
					    (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))
					    (dashboard:update-run-command tabdat))
					  "command-testname-selector tb action"))
			      #:value (dboard:test-patt->lines
				       (dboard:tabdat-test-patts-use tabdat))
			      #:expand "HORIZONTAL"

			      ))
	 (tb
          (iup:treebox
           #:value 0
           #:name "Runs"
           #:expand "YES"
           #:addexpanded "NO"
           #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (tree-path->run-id tabdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number
︙︙
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453

1454
1455
1456
1457
1458
1459
1460

						       (dboard:tabdat-last-data-update-set! tabdat (current-seconds))
						       (thread-start! (make-thread
								       (lambda ()
									 (dboard:tabdat-running-layout-set! tabdat #t)
									 (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
									 (dboard:tabdat-running-layout-set! tabdat #f))
								       "run-times-tab-layout-updater"))))
                               ;;(dboard:tabdat-view-changed-set! tabdat #t)
                               )))))
        (dboard:tabdat-graph-matrix-set! tabdat graph-matrix)
        (iup:attribute-set! graph-matrix "WIDTH0" 0)
        (iup:attribute-set! graph-matrix "HEIGHT0" 0)
        graph-matrix))
      (iup:hbox
       (iup:vbox
        (iup:button "Show All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #t)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat))))))

       (iup:hbox
        (iup:button "Hide All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #f)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat)))))))

      ))))

;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time








|











|
>





|
>








1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463

						       (dboard:tabdat-last-data-update-set! tabdat (current-seconds))
						       (thread-start! (make-thread
								       (lambda ()
									 (dboard:tabdat-running-layout-set! tabdat #t)
									 (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
									 (dboard:tabdat-running-layout-set! tabdat #f))
								       "run-times-tab-layout-updater"))))
                               (dboard:tabdat-rebuild-dwg-set! tabdat #t)
                               )))))
        (dboard:tabdat-graph-matrix-set! tabdat graph-matrix)
        (iup:attribute-set! graph-matrix "WIDTH0" 0)
        (iup:attribute-set! graph-matrix "HEIGHT0" 0)
        graph-matrix))
      (iup:hbox
       (iup:vbox
        (iup:button "Show All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #t)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat)))
                                          (dboard:tabdat-rebuild-dwg-set! tabdat #t))))
       (iup:hbox
        (iup:button "Hide All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #f)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat)))
                                          (dboard:tabdat-rebuild-dwg-set! tabdat #t)))))
      ))))

;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time
︙︙
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469

    (iup:show
     (iup:dialog 
      #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (iup:split
			  #:orientation "VERTICAL" ;; "HORIZONTAL"
			  #:value 150
			  (dboard:runs-tree-browser commondat runs-dat)
			  (iup:split
			   ;; left most block, including row names
			   (apply iup:vbox lftlst)
			   ;; right hand block, including cells
			   (iup:vbox
			    ;; the header
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst)))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       5)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat








|

|
|
|
|
|
|
|
|








2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472

    (iup:show
     (iup:dialog 
      #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (iup:split
			  #:orientation "VERTICAL" ;; "HORIZONTAL"
			  #:value 200
			  (dboard:runs-tree-browser commondat runs-dat)
                           (iup:split
                            ;; left most block, including row names
                            (apply iup:vbox lftlst)
                            ;; right hand block, including cells
                            (iup:vbox
                             ;; the header
                             (apply iup:hbox (reverse hdrlst))
                             (apply iup:hbox (reverse bdylst)))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       5)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat
︙︙
2758
2759
2760
2761
2762
2763
2764

2765
2766

2767
2768
2769
2770
2771
2772
2773
2774
2775
2776


2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796


2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809

2810

2811
2812
2813
2814
2815
2816
2817

                                   (list? (dboard:tabdat-target tabdat))
                                   (not (null? (dboard:tabdat-target tabdat))))
                              (last (dboard:tabdat-target tabdat))
                              "%"))
	       (testpatt  (or (dboard:tabdat-test-patts tabdat) "%"))
	       (filtrstr  (conc targpatt "/" runpatt "/" testpatt)))
	  ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)


	  (if (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))

	      (let ((dwg (dboard:tabdat-drawing tabdat)))
		(print "reseting drawing")
		(dboard:tabdat-layout-update-ok-set! tabdat #f)
		(vg:drawing-libs-set! dwg (make-hash-table))
		(vg:drawing-insts-set! dwg (make-hash-table))
		(vg:drawing-cache-set! dwg '())
		(dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)
		(dboard:tabdat-last-filter-str-set! tabdat filtrstr)))


	  (update-rundat tabdat
			 runpatt
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 (dboard:tabdat-numruns tabdat)
			 testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			 
			 targpatt
			 
			 ;; old method 
			 ;; (let ((res '()))
			 ;;   (for-each (lambda (key)
			 ;;      	 (if (not (equal? key "runname"))
			 ;;      	     (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
			 ;;      	       (if val (set! res (cons (list key val) res))))))
			 ;;             (dboard:tabdat-dbkeys tabdat))
			 ;;   res)
			 )))))

;; run times canvas updater


;;
(define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
  (let ((cnv (dboard:tabdat-cnv tabdat))
	(dwg (dboard:tabdat-drawing tabdat))
	(mtx (dboard:tabdat-runs-mutex tabdat))
	(vch (dboard:tabdat-view-changed tabdat)))
    (if (and cnv dwg vch)
	(begin
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)

	  (mutex-unlock! mtx)

	  (dboard:tabdat-view-changed-set! tabdat #f)))))
  
;; doesn't work.
;;
;;(define (gotoescape tabdat escape)
;;  (or (dboard:tabdat-layout-update-ok tabdat)
;;      (escape #t)))








>

|
>

|







|
>
>




















>
>













>

>








2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828

                                   (list? (dboard:tabdat-target tabdat))
                                   (not (null? (dboard:tabdat-target tabdat))))
                              (last (dboard:tabdat-target tabdat))
                              "%"))
	       (testpatt  (or (dboard:tabdat-test-patts tabdat) "%"))
	       (filtrstr  (conc targpatt "/" runpatt "/" testpatt)))
	  ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)
          (print "RA => dboard:tabdat-last-filter-str " dboard:tabdat-last-filter-str "filtrstr" filtrstr "dboard:tabdat-view-changed" (dboard:tabdat-view-changed tabdat))

	  (if (or (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
                  (dboard:tabdat-rebuild-dwg tabdat))
	      (let ((dwg (dboard:tabdat-drawing tabdat)))
		(print "resetting drawing")
		(dboard:tabdat-layout-update-ok-set! tabdat #f)
		(vg:drawing-libs-set! dwg (make-hash-table))
		(vg:drawing-insts-set! dwg (make-hash-table))
		(vg:drawing-cache-set! dwg '())
		(dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)
		(dboard:tabdat-last-filter-str-set! tabdat filtrstr)
                ;; (dboard:tabdat-rebuild-dwg-set! tabdat #f)
                ))
	  (update-rundat tabdat
			 runpatt
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 (dboard:tabdat-numruns tabdat)
			 testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			 
			 targpatt
			 
			 ;; old method 
			 ;; (let ((res '()))
			 ;;   (for-each (lambda (key)
			 ;;      	 (if (not (equal? key "runname"))
			 ;;      	     (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
			 ;;      	       (if val (set! res (cons (list key val) res))))))
			 ;;             (dboard:tabdat-dbkeys tabdat))
			 ;;   res)
			 )))))

;; run times canvas updater
;; NOTE: this is for redrawing the canvas but does NOT change the underlying data that constitues
;;       our charts/graphs being drawn.
;;
(define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
  (let ((cnv (dboard:tabdat-cnv tabdat))
	(dwg (dboard:tabdat-drawing tabdat))
	(mtx (dboard:tabdat-runs-mutex tabdat))
	(vch (dboard:tabdat-view-changed tabdat)))
    (if (and cnv dwg vch)
	(begin
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
          ;; RA => (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
	  (mutex-unlock! mtx)
          (print "RA => View changed found to be set" )
	  (dboard:tabdat-view-changed-set! tabdat #f)))))
  
;; doesn't work.
;;
;;(define (gotoescape tabdat escape)
;;  (or (dboard:tabdat-layout-update-ok tabdat)
;;      (escape #t)))
︙︙

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