| ︙ | | | ︙ | |
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(exit 1)))
(define *db* (open-db))
(define toplevel #f)
(define dlg #f)
(define max-test-num 0)
(define *keys* (get-keys *db*))
(define *dbkeys* (map (lambda (x)(vector-ref x 0))
(append *keys* (list (vector "runname" "blah")))))
(define *header* #f)
(define *allruns* '())
(define *buttondat* (make-hash-table)) ;; <run-id color text test run-key>
(define *alltestnamelst* '())
(define *searchpatts* (make-hash-table))
(define *num-runs* 8)
(define *tot-run-count* (db:get-num-runs *db* "%"))
(define *last-update* (current-seconds))
(define *num-tests* 15)
(define *start-run-offset* 0)
(define *start-test-offset* 0)
(define *examine-test-dat* (make-hash-table))
(define *exit-started* #f)
(define *status-ignore-hash* (make-hash-table))
|
|
|
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(exit 1)))
(define *db* (open-db))
(define toplevel #f)
(define dlg #f)
(define max-test-num 0)
(define *keys* (rdb:get-keys *db*))
(define *dbkeys* (map (lambda (x)(vector-ref x 0))
(append *keys* (list (vector "runname" "blah")))))
(define *header* #f)
(define *allruns* '())
(define *buttondat* (make-hash-table)) ;; <run-id color text test run-key>
(define *alltestnamelst* '())
(define *searchpatts* (make-hash-table))
(define *num-runs* 8)
(define *tot-run-count* (rdb:get-num-runs *db* "%"))
(define *last-update* (current-seconds))
(define *num-tests* 15)
(define *start-run-offset* 0)
(define *start-test-offset* 0)
(define *examine-test-dat* (make-hash-table))
(define *exit-started* #f)
(define *status-ignore-hash* (make-hash-table))
|
| ︙ | | | ︙ | |
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
(define uidat #f)
(define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
;; (megatest-dashboard)
;(define img1 (iup:image/palette 16 16 (u8vector->blob (u8vector
; 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2
; 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2
; 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2
; 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2
; 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2
; 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2
; 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2
; 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0
; 2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2
; 2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2
; 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0
; 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 1))))
;
;(define img2 (iup:image/palette 16 16 (u8vector->blob (u8vector
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1
; 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
; 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2
; 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2
; 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2
; 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2
; 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2
; 2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0
; 2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2
; 2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2
; 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0
; 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 1))))
;
;(iup:handle-name-set! img1 "img1")
;(iup:attribute-set! img1 "0" "0 0 0")
;(iup:attribute-set! img1 "1" "BGCOLOR")
;(iup:attribute-set! img1 "2" "255 0 0")
;
;(iup:handle-name-set! img2 "img2")
;(iup:attribute-set! img2 "0" "0 0 0")
;(iup:attribute-set! img2 "1" "BGCOLOR")
;(iup:attribute-set! img2 "2" "255 0 0")
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(define uidat #f)
(define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
(define (message-window msg)
(iup:show
(iup:dialog
(iup:vbox
(iup:label msg #:margin "40x40")))))
|
| ︙ | | | ︙ | |
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
(let ((modtime (file-modification-time *db-file-path*)))
(if (or (> modtime *last-db-update-time*)
(> *delayed-update* 0))
(begin
(set! *please-update-buttons* #t)
(set! *last-db-update-time* modtime)
(set! *delayed-update* (- *delayed-update* 1))
(let* ((allruns (db:get-runs *db* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
*start-run-offset* keypatts))
(header (db:get-header allruns))
(runs (db:get-rows allruns))
(result '())
(maxtests 0)
(states (hash-table-keys *state-ignore-hash*))
(statuses (hash-table-keys *status-ignore-hash*)))
(debug:print 6 "update-rundat, got " (length runs) " runs")
(if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes
(begin
(set! *last-update* (current-seconds))
(set! *tot-run-count* (db:get-num-runs *db* runnamepatt))))
(for-each (lambda (run)
(let* ((run-id (db:get-value-by-header run header "id"))
(tests (let ((tsts (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses)))
(if *tests-sort-reverse* (reverse tsts) tsts)))
(key-vals (get-key-vals *db* run-id)))
(if (> (length tests) maxtests)
(set! maxtests (length tests)))
(if (or (not *hide-empty-runs*) ;; this reduces the data burden when set
(not (null? tests)))
(set! result (cons (vector run tests key-vals) result)))))
runs)
(set! *header* header)
|
|
|
|
|
|
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(let ((modtime (file-modification-time *db-file-path*)))
(if (or (> modtime *last-db-update-time*)
(> *delayed-update* 0))
(begin
(set! *please-update-buttons* #t)
(set! *last-db-update-time* modtime)
(set! *delayed-update* (- *delayed-update* 1))
(let* ((allruns (rdb:get-runs *db* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
*start-run-offset* keypatts))
(header (db:get-header allruns))
(runs (db:get-rows allruns))
(result '())
(maxtests 0)
(states (hash-table-keys *state-ignore-hash*))
(statuses (hash-table-keys *status-ignore-hash*)))
(debug:print 6 "update-rundat, got " (length runs) " runs")
(if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes
(begin
(set! *last-update* (current-seconds))
(set! *tot-run-count* (rdb:get-num-runs *db* runnamepatt))))
(for-each (lambda (run)
(let* ((run-id (db:get-value-by-header run header "id"))
(tests (let ((tsts (rdb:get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses)))
(if *tests-sort-reverse* (reverse tsts) tsts)))
(key-vals (rdb:get-key-vals *db* run-id)))
(if (> (length tests) maxtests)
(set! maxtests (length tests)))
(if (or (not *hide-empty-runs*) ;; this reduces the data burden when set
(not (null? tests)))
(set! result (cons (vector run tests key-vals) result)))))
runs)
(set! *header* header)
|
| ︙ | | | ︙ | |
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
(string>= (vector-ref a 0)(vector-ref b 0))))))
(map (lambda (x)
(if (equal? (vector-ref x 1) "")
(vector-ref x 0)
(conc (vector-ref x 0) "(" (vector-ref x 1) ")")))
vlst-s2)))
;; (sort newlst (lambda (a b)
;; (let* ((partsa (string-split a "("))
;; (partsb (string-split b "("))
;; (lena (length partsa))
;; (lenb (length partsb)))
;; (if (or (and (eq? lena 1)(> lenb 1))
;; (and (eq? lenb 1)(> lena 1)))
;; (if (equal? (car partsa)(car partsb)) ;; same test
;; (> lenb lena)
;; #t)
;; #t))))))
|
<
<
<
<
<
<
<
<
<
<
<
<
|
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
(string>= (vector-ref a 0)(vector-ref b 0))))))
(map (lambda (x)
(if (equal? (vector-ref x 1) "")
(vector-ref x 0)
(conc (vector-ref x 0) "(" (vector-ref x 1) ")")))
vlst-s2)))
(define (update-labels uidat)
(let* ((rown 0)
(keycol (dboard:uidat-get-keycol uidat))
(lftcol (dboard:uidat-get-lftcol uidat))
(numcols (vector-length lftcol))
(maxn (- numcols 1))
(allvals (make-vector numcols "")))
|
| ︙ | | | ︙ | |