Megatest

Check-in [8302b2e45a]
Login
Overview
Comment:Some clean up after refactor
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 8302b2e45af1ec406a7d1cc57484a37329cd0504
User & Date: matt on 2016-07-10 21:45:48
Other Links: branch diff | manifest | tags
Context
2016-07-10
23:57
More cleanup check-in: 2895ef3399 user: matt tags: v1.61
21:45
Some clean up after refactor check-in: 8302b2e45a user: matt tags: v1.61
20:20
Refactored updaters. Not completed yet but it compiles check-in: 908a92225c user: matt tags: v1.61
Changes

Modified dashboard.scm from [b54049fefc] to [d875af2eaf].

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
       (iup:vbox
	(dcommon:section-matrix rawconfig "server" "Varname" "Value")
	;; (iup:frame
	;; #:title "Disks Areas"
	(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
     (iup:frame
      #:title "Run statistics"
      (dcommon:run-stats tabdat)))))

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








|







1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
       (iup:vbox
	(dcommon:section-matrix rawconfig "server" "Varname" "Value")
	;; (iup:frame
	;; #:title "Disks Areas"
	(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
     (iup:frame
      #:title "Run statistics"
      (dcommon:run-stats commondat tabdat)))))

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

1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
1843
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:monitor-changed? commondat tabdat)

  (let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))
    (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0)
	     (or (> monitor-modtime *last-monitor-update-time*)
		 (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
	(begin







>
|







1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))
    (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0)
	     (or (> monitor-modtime *last-monitor-update-time*)
		 (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
	(begin
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
      (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
					  ;; (dboard:tabdat-numruns tabdat)
					  ;; (dboard:tabdat-num-tests tabdat)
					  ;; (dboard:tabdat-dbkeys tabdat)
					  ;; runs-sum-dat new-view-dat))
      ;; legacy setup of updaters for summary tab and runs tab
      ;; summary tab
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
	 (dashboard:summary-tab-updater commondat 0))
       tab-num: 0)
      ;; runs tab
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
	 (dashboard:runs-tab-updater commondat 1))
       tab-num: 1)
      (iup:callback-set! *tim*







|
|
|
|
|







1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
      (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
					  ;; (dboard:tabdat-numruns tabdat)
					  ;; (dboard:tabdat-num-tests tabdat)
					  ;; (dboard:tabdat-dbkeys tabdat)
					  ;; runs-sum-dat new-view-dat))
      ;; legacy setup of updaters for summary tab and runs tab
      ;; summary tab
      ;; (dboard:commondat-add-updater 
      ;;  commondat 
      ;;  (lambda ()
      ;; 	 (dashboard:summary-tab-updater commondat 0))
      ;;  tab-num: 0)
      ;; runs tab
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
	 (dashboard:runs-tab-updater commondat 1))
       tab-num: 1)
      (iup:callback-set! *tim*
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
				   (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				 ))
			   1))))
    
    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t)
			      (dashboard:run-update commondat)
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))

(main)







|







1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
				   (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				 ))
			   1))))
    
    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t)
			      ;; (dashboard:run-update commondat)
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))

(main)

Modified dcommon.scm from [3d55a423e4] to [60f5633a1e].

354
355
356
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
    ;; (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "2:0" "Version")
    (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))

    general-matrix))

(define (dcommon:run-stats alldat)
  (let* ((stats-matrix (iup:matrix expand: "YES"))
	 (changed      #f)
	 (updater      (lambda ()

			 (let* ((run-stats    (rmt:get-run-stats))
				(indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				(row-indices  (car indices))
				(col-indices  (cadr indices))
				(max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				(max-col      (if (null? col-indices) 1 
						  (apply max (map cadr col-indices))))
				(max-visible  (max (- (dboard:tabdat-num-tests alldat) 15) 3))
				(max-col-vis  (if (> max-col 10) 10 max-col))
				(numrows      1)
				(numcols      1))
			   (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
			   (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-vis)







|



>







|







354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
    ;; (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "2:0" "Version")
    (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))

    general-matrix))

(define (dcommon:run-stats commondat tabdat)
  (let* ((stats-matrix (iup:matrix expand: "YES"))
	 (changed      #f)
	 (updater      (lambda ()
			 (if (dashboard:database-changed? commondat tabdat)
			 (let* ((run-stats    (rmt:get-run-stats))
				(indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				(row-indices  (car indices))
				(col-indices  (cadr indices))
				(max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				(max-col      (if (null? col-indices) 1 
						  (apply max (map cadr col-indices))))
				    (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
				(max-col-vis  (if (> max-col 10) 10 max-col))
				(numrows      1)
				(numcols      1))
			   (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
			   (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-vis)
410
411
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426
					      (col-num  (cadr (assoc col-name col-indices)))
					      (key      (conc row-num ":" col-num)))
					 (if (not (equal? (iup:attribute stats-matrix key) value))
					     (begin
					       (set! changed #t)
					       (iup:attribute-set! stats-matrix key value)))))
				     run-stats)
			   (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))))
    (updater)

    (set! dashboard:update-summary-tab updater)
    (iup:attribute-set! stats-matrix "WIDTHDEF" "40")
    (iup:vbox
     ;; (iup:label "Run statistics"  #:expand "HORIZONTAL")
     stats-matrix)))

(define (dcommon:servers-table commondat tabdat)
  (let* ((tdbdat         (tasks:open-db))







|

>
|







411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
					      (col-num  (cadr (assoc col-name col-indices)))
					      (key      (conc row-num ":" col-num)))
					 (if (not (equal? (iup:attribute stats-matrix key) value))
					     (begin
					       (set! changed #t)
					       (iup:attribute-set! stats-matrix key value)))))
				     run-stats)
			       (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))))))
    (updater)
    (dboard:commondat-add-updater commondat updater)
    ;; (set! dashboard:update-summary-tab updater)
    (iup:attribute-set! stats-matrix "WIDTHDEF" "40")
    (iup:vbox
     ;; (iup:label "Run statistics"  #:expand "HORIZONTAL")
     stats-matrix)))

(define (dcommon:servers-table commondat tabdat)
  (let* ((tdbdat         (tasks:open-db))
474
475
476
477
478
479
480
481

482
483
484
485
486
487
488
				  servers))))))
    (set! colnum 0)
    (for-each (lambda (colname)
		(iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
		(iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))
		(set! colnum (+ colnum 1)))
	      colnames)
    (set! dashboard:update-servers-table updater) 

    ;; (iup:attribute-set! servers-matrix "WIDTHDEF" "40")
   ;;  (iup:hbox
   ;;   (iup:vbox
   ;;    (iup:button "Start"
   ;;      	  ;; #:size "50x"
   ;;      	  #:expand "YES"
   ;;      	  #:action (lambda (obj)







|
>







476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
				  servers))))))
    (set! colnum 0)
    (for-each (lambda (colname)
		(iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
		(iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))
		(set! colnum (+ colnum 1)))
	      colnames)
    ;; (set! dashboard:update-servers-table updater) 
    (dboard:commondat-add-updater commondat updater)
    ;; (iup:attribute-set! servers-matrix "WIDTHDEF" "40")
   ;;  (iup:hbox
   ;;   (iup:vbox
   ;;    (iup:button "Start"
   ;;      	  ;; #:size "50x"
   ;;      	  #:expand "YES"
   ;;      	  #:action (lambda (obj)
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
   #:title "SELECTORS"
   (iup:vbox
    ;; Text box for test patterns
    (iup:frame
     #:title "Test patterns (one per line)"
     (let ((tb (iup:textbox #:action (lambda (val a b)
				       (dboard:tabdat-test-patts-set!-use
					data
					(dboard:lines->test-patt b))
				       (dashboard:update-run-command tabdat))
			    #:value (dboard:test-patt->lines
				     (dboard:tabdat-test-patts-use tabdat))
			    #:expand "YES"
			    #:size "x50"
			    #:multiline "YES")))







|







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
   #:title "SELECTORS"
   (iup:vbox
    ;; Text box for test patterns
    (iup:frame
     #:title "Test patterns (one per line)"
     (let ((tb (iup:textbox #:action (lambda (val a b)
				       (dboard:tabdat-test-patts-set!-use
					tabdat
					(dboard:lines->test-patt b))
				       (dashboard:update-run-command tabdat))
			    #:value (dboard:test-patt->lines
				     (dboard:tabdat-test-patts-use tabdat))
			    #:expand "YES"
			    #:size "x50"
			    #:multiline "YES")))