| ︙ | | |
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
-
+
-
+
|
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(BB> "Before common:watchdog spawn")
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(BB> "After common:watchdog spawn")
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
(if (not (args:get-arg "-use-db-cache"))
(begin
(debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
(hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;; data common to all tabs goes here
;;
|
| ︙ | | |
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
|
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
|
-
-
+
+
|
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
(tests-dat (dashboard:tests-ht->tests-dat tests-ht))
(tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat)
(hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10))
(when (not run)
(BB> "ERROR: NO RUN FOR RUN-ID run-id="run-id)
(BB> "runs-hash-> " (hash-table->alist runs-hash))
(debug:print-info 13 *default-log-port* "ERROR: NO RUN FOR RUN-ID run-id="run-id)
(debug:print-info 13 *default-log-port* "runs-hash-> " (hash-table->alist runs-hash))
)
tests-mindat))
(define (dashboard:runs-summary-xor-matrix-content tabdat runs-hash #!key (hide-clean #f))
(let* ((src-run-id (dboard:tabdat-prev-run-id tabdat))
(dest-run-id (dboard:tabdat-curr-run-id tabdat)))
(if (and src-run-id dest-run-id)
|
| ︙ | | |
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
|
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
|
-
+
|
(debug:catch-and-dump
(lambda ()
;; Bummer - we dont have the global get/set api mapped in chicken
;; (let* ((modkeys (iup:global "MODKEYSTATE")))
;; (BB> "modkeys="modkeys))
(BB> "click-cb: obj="obj" lin="lin" col="col" status="status)
(debug:print-info 13 *default-log-port* "click-cb: obj="obj" lin="lin" col="col" status="status)
;; status is corrupted on Brandon's home machine. will have to wait until after shutdown to see if it is still broken in PDX SLES
(let* ((toolpath (car (argv)))
(key (conc lin ":" col))
(test-id (hash-table-ref/default cell-lookup key -1))
(run-id (dboard:tabdat-curr-run-id tabdat))
(run-info (rmt:get-run-info run-id))
(target (rmt:get-target run-id))
|
| ︙ | | |
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
|
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
|
-
+
-
+
-
+
|
"%")))
(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)))
(status-chars (char-set->list (string->char-set status)))
(testpanel-cmd (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id " &")))
(BB> "status-chars=["status-chars"] status=["status"]")
(debug:print-info 13 *default-log-port* "status-chars=["status-chars"] status=["status"]")
(cond
((member #\1 status-chars) ;; 1 is left mouse button
(system testpanel-cmd))
((member #\2 status-chars) ;; 2 is middle mouse button
(BB> "mmb- test-name="test-name" testpatt="testpatt)
(debug:print-info 13 *default-log-port* "mmb- test-name="test-name" testpatt="testpatt)
(iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
)
(else
(BB> "unhandled status in run-summary-click-cb. Doing right click action. (status is corrupted on Brandon's ubuntu host - bad/buggy iup install??" )
(debug:print-info 13 *default-log-port* "unhandled status in run-summary-click-cb. Doing right click action. (status is corrupted on Brandon's ubuntu host - bad/buggy iup install??" )
(iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
)
)
|
| ︙ | | |
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
|
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
|
-
+
|
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
;;(tabdat-values tabdat) ;;RA added
;; (pp (dboard:tabdat->alist tabdat))
;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-rundat)
(dashboard:do-update-rundat tabdat)
;;(BB> "dashboard:runs-tab-updater")
;;(debug:print-info 13 *default-log-port* "dashboard:runs-tab-updater")
;;(inspect tabdat)
(let ((uidat (dboard:commondat-uidat commondat)))
;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat)
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
"dashboard:runs-tab-updater"))
|
| ︙ | | |