Megatest

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

Changes In Branch rebase-runs-summary-contexts-menu Through [a2e344d47e] Excluding Merge-Ins

This is equivalent to a diff from 9558941541 to a2e344d47e

2016-09-16
23:49
fixed bug Closed-Leaf check-in: b340b2ea35 user: bb tags: rebase-runs-summary-contexts-menu
17:49
rebase continues. Merging in 95589 check-in: a2e344d47e user: mrwellan tags: rebase-runs-summary-contexts-menu
17:28
Start of rebase of runs-summary-contexts-menu to v1.62 check-in: 8c0fc4736d user: mrwellan tags: rebase-runs-summary-contexts-menu
2016-09-13
18:52
added xor features: 1) - button to hide CLEAN-* 2) make CLEAN-{FAIL,CHECK,ABORT} orange check-in: 36fb66d697 user: bjbarcla tags: v1.62
18:13
v1.62 now has all new features of xor-two-runs branch check-in: 9558941541 user: bjbarcla tags: v1.62
15:36
adding mode selector logic to runs-summary tab; added xor mode elements check-in: 5178c56168 user: bjbarcla tags: v1.62

Modified dashboard.scm from [e628e410e9] to [79a3912085].

︙︙
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

  ;; runs
  ((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          (string->number (or (args:get-arg "-cols") "8")))                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  ((last-runs-update  0)                 : number)      ;; last time we pulled the runs info to update the tree
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id
  ((last-test-dat      (make-hash-table)) : hash-table)  ;; cache last tests dat by run-id
  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files








|








166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

  ;; runs
  ((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          (string->number (or (args:get-arg "-cols") "10")))                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  ((last-runs-update  0)                 : number)      ;; last time we pulled the runs info to update the tree
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id
  ((last-test-dat      (make-hash-table)) : hash-table)  ;; cache last tests dat by run-id
  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files
︙︙
481
482
483
484
485
486
487
488


489
490
491
492
493
494
495

;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((num-to-get  20)


	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname








|
>
>








481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((num-to-get  (let ((n (configf:lookup *configdat* "dashboard" "num-to-get")))
			(if n (string->number n)
			    30)))
	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname
︙︙
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537

	 (use-new    (dboard:tabdat-hide-not-hide tabdat))
	 (tests-ht   (if (dboard:tabdat-filters-changed tabdat)
			 (let ((ht (make-hash-table)))
			   (dboard:rundat-tests-set! run-dat ht)
			   ht)
			 (dboard:rundat-tests run-dat)))
	 (start-time (current-seconds)))

    ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset
    (dboard:rundat-run-data-offset-set! 
     run-dat 
     (if (< (length tmptests) num-to-get)
	 0
	 (let ((newval (+ num-to-get (dboard:rundat-run-data-offset run-dat))))
	   ;; (print "Incremental get, offset=" (dboard:rundat-run-data-offset run-dat) " retrieved: " (length tmptests) " newval: " newval)








|








525
526
527
528
529
530
531
532
533
534
535
536
537
538
539

	 (use-new    (dboard:tabdat-hide-not-hide tabdat))
	 (tests-ht   (if (dboard:tabdat-filters-changed tabdat)
			 (let ((ht (make-hash-table)))
			   (dboard:rundat-tests-set! run-dat ht)
			   ht)
			 (dboard:rundat-tests run-dat)))
	 (start-time (current-seconds)))
    ;; (dashboard:set-db-update-time tabdat) ;; indicate that we did read the db at this time
    ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset
    (dboard:rundat-run-data-offset-set! 
     run-dat 
     (if (< (length tmptests) num-to-get)
	 0
	 (let ((newval (+ num-to-get (dboard:rundat-run-data-offset run-dat))))
	   ;; (print "Incremental get, offset=" (dboard:rundat-run-data-offset run-dat) " retrieved: " (length tmptests) " newval: " newval)
︙︙
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949


(define (update-search commondat tabdat x val)
  (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (set-bg-on-filter commondat tabdat))

(define (mark-for-update tabdat)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (dboard:tabdat-last-db-update-set! tabdat 0))

;;======================================================================
;; R U N C O N T R O L
;;======================================================================

;; target populating logic








|








937
938
939
940
941
942
943
944
945
946
947
948
949
950
951


(define (update-search commondat tabdat x val)
  (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (set-bg-on-filter commondat tabdat))

(define (mark-for-update tabdat)
  ;; (dboard:tabdat-filters-changed-set! tabdat #t)
  (dboard:tabdat-last-db-update-set! tabdat 0))

;;======================================================================
;; R U N C O N T R O L
;;======================================================================

;; target populating logic
︙︙
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019

					       (oldmax   (string->number (iup:attribute obj "MAX")))
					       (maxruns  (dboard:tabdat-tot-runs tabdat)))
					   (dboard:tabdat-start-run-offset-set! tabdat val)
					   (mark-for-update tabdat)
					   (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
					   (iup:attribute-set! obj "MAX" (* maxruns 10))))
		     #:expand "HORIZONTAL"
		     #:max (* 10 (length (dboard:tabdat-allruns tabdat)))
		     #:min 0
		     #:step 0.01)))
     ;;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1))))
					;(iup:button "dec rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (if (> (dboard:tabdat-num-tests tabdat) 0)(- (dboard:tabdat-num-tests tabdat) 1) 0))))
     )))

(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt)
  (iup:menu 
   (iup:menu-item
    "Run"
    (iup:menu              
     (iup:menu-item
      (conc "Rerun " testpatt)
      #:action
      (lambda (obj)
        ;;(print "buttndat: " buttndat " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt)
	(common:run-a-command
	 (conc "megatest -run -target " target
	       " -runname " runname
	       " -testpatt " testpatt
	       " -preclean -clean-cache")
	 )))
     (iup:menu-item








|






|








|








1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021

					       (oldmax   (string->number (iup:attribute obj "MAX")))
					       (maxruns  (dboard:tabdat-tot-runs tabdat)))
					   (dboard:tabdat-start-run-offset-set! tabdat val)
					   (mark-for-update tabdat)
					   (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
					   (iup:attribute-set! obj "MAX" (* maxruns 10))))
		     #:expand "HORIZONTAL"
		     #:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		     #:min 0
		     #:step 0.01)))
     ;;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1))))
					;(iup:button "dec rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (if (> (dboard:tabdat-num-tests tabdat) 0)(- (dboard:tabdat-num-tests tabdat) 1) 0))))
     )))

(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt item-test-path)
  (iup:menu 
   (iup:menu-item
    "Run"
    (iup:menu              
     (iup:menu-item
      (conc "Rerun " testpatt)
      #:action
      (lambda (obj)
        ;; (print "buttndat: " buttndat " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt "item-path : " item-path)
	(common:run-a-command
	 (conc "megatest -run -target " target
	       " -runname " runname
	       " -testpatt " testpatt
	       " -preclean -clean-cache")
	 )))
     (iup:menu-item
︙︙
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072

         (conc "megatest -remove-runs -target " target
               " -runname " runname
               " -testpatt % "))))))
   (iup:menu-item
    "Test"
    (iup:menu 
     (iup:menu-item
      (conc "Rerun " test-name)
      #:action
      (lambda (obj)
	(common:run-a-command
	 (conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
               " -runname " runname
	       " -testpatt " test-name
	       " -preclean -clean-cache"))))
     (iup:menu-item
      (conc "Kill " test-name)
      #:action
      (lambda (obj)
        ;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
	(common:run-a-command
	 (conc "megatest -set-state-status KILLREQ,n/a -target " target
               " -runname " runname
	       " -testpatt " test-name
	       " -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
     (iup:menu-item
      (conc "Clean " test-name)
      #:action
      (lambda (obj)
	(common:run-a-command
	 (conc "megatest -remove-runs -target " target
               " -runname " runname
	       " -testpatt " test-name))))
     (iup:menu-item
      "Start xterm"
      #:action
      (lambda (obj)
        (dcommon:examine-xterm run-id test-id)))
	;;(let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&")))
	;; (system cmd))))








|





|


|






|


|





|








2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074

         (conc "megatest -remove-runs -target " target
               " -runname " runname
               " -testpatt % "))))))
   (iup:menu-item
    "Test"
    (iup:menu 
     (iup:menu-item
      (conc "Rerun " item-test-path)
      #:action
      (lambda (obj)
	(common:run-a-command
	 (conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
               " -runname " runname
	       " -testpatt " item-test-path
	       " -preclean -clean-cache"))))
     (iup:menu-item
      (conc "Kill " item-test-path)
      #:action
      (lambda (obj)
        ;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
	(common:run-a-command
	 (conc "megatest -set-state-status KILLREQ,n/a -target " target
               " -runname " runname
	       " -testpatt " item-test-path 
	       " -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
     (iup:menu-item
      (conc "Clean "item-test-path)
      #:action
      (lambda (obj)
	(common:run-a-command
	 (conc "megatest -remove-runs -target " target
               " -runname " runname
	       " -testpatt " item-test-path))))
     (iup:menu-item
      "Start xterm"
      #:action
      (lambda (obj)
        (dcommon:examine-xterm run-id test-id)))
	;;(let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&")))
	;; (system cmd))))
︙︙
2212
2213
2214
2215
2216
2217
2218
2219




2220
2221
2222
2223
2224
2225
2226
2227

					      (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
					      (testpatt  (let ((tlast (rmt:tasks-get-last target runname)))
							   (if tlast
							       (let ((tpatt (tasks:task-get-testpatt tlast)))
								 (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
								     "%"
								     tpatt))
							       "%"))))




					 (iup:show (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt) ;; popup-menu
						   #:x 'mouse
						   #:y 'mouse
						   #:modal? "NO")
					 ;; (print "got here")
					 ))
				   (if (eq? pressed 0)
				       (let* ((toolpath (car (argv)))








|
>
>
>
>
|








2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233

					      (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
					      (testpatt  (let ((tlast (rmt:tasks-get-last target runname)))
							   (if tlast
							       (let ((tpatt (tasks:task-get-testpatt tlast)))
								 (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
								     "%"
								     tpatt))
							       "%")))
                                              (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
                                              (item-test-path (conc test-name "/" (if (equal? item-path "")
									"%" 
									item-path))))
					 (iup:show (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
						   #:x 'mouse
						   #:y 'mouse
						   #:modal? "NO")
					 ;; (print "got here")
					 ))
				   (if (eq? pressed 0)
				       (let* ((toolpath (car (argv)))
︙︙
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580

		(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" "%") 
			 10  ;; (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 '()))








|








2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586

		(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 '()))
︙︙

Modified dcommon.scm from [6c1246c6e1] to [1493d6cb58].

︙︙
505
506
507
508
509
510
511

512
513
514
515
516
517
518

				    (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)
			       (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))

			       ;; Row labels








>








505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

				    (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))
			       (dashboard:set-db-update-time tabdat)
			       (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)
			       (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))

			       ;; Row labels
︙︙

Modified megatest.scm from [8777b38b5a] to [36ef6b845c].

︙︙
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       ;; this is "-since" support. This looks at last mod times of <run-id>.db files
	       ;; and collects those modified since the -since time.
	       (runs        (if (and (not (null? runstmp))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))








|








1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       ;; this is "-since" support. This looks at last mod times of <run-id>.db files
	       ;; and collects those modified since the -since time.
	       (runs        (if (and (not (null? runstmp))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
︙︙

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