138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
(set! maxtests (length tests)))
(set! result (cons (vector run tests key-vals) result))))
runs)
(set! *header* header)
(set! *allruns* result)
maxtests))
(define (update-labels uidat)
(let* ((rown 0)
(lftcol (vector-ref uidat 0))
(numcols (vector-length lftcol))
(maxn (- numcols 1))
(allvals (make-vector numcols "")))
(for-each (lambda (name)
|
>
>
>
>
>
>
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
(set! maxtests (length tests)))
(set! result (cons (vector run tests key-vals) result))))
runs)
(set! *header* header)
(set! *allruns* result)
maxtests))
(define *collapsed* (make-hash-table))
(define (toggle-hide testname)
(if (hash-table-ref/default *collapsed* testname #f)
(hash-table-delete! *collapsed* testname)
(hash-table-set! *collapsed* testname #t)))
(define (update-labels uidat)
(let* ((rown 0)
(lftcol (vector-ref uidat 0))
(numcols (vector-length lftcol))
(maxn (- numcols 1))
(allvals (make-vector numcols "")))
(for-each (lambda (name)
|
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
(take-right *allruns* numruns)
(pad-list *allruns* numruns)))
(lftcol (vector-ref uidat 0))
(tableheader (vector-ref uidat 1))
(table (vector-ref uidat 2))
(coln 0))
(update-labels uidat)
(for-each
(lambda (popup)
(let* ((test-id (car popup))
(widgets (hash-table-ref *examine-test-dat* popup))
(stepslbl (hash-table-ref/default widgets "Test Steps" #f)))
(if stepslbl
(let* ((fmtstr "~15a~8a~8a~20a")
(newtxt (string-intersperse
(append
(list
(format #f fmtstr "Stepname" "State" "Status" "Event Time")
(format #f fmtstr "========" "=====" "======" "=========="))
(map (lambda (x)
;; take advantage of the \n on time->string
(format #f fmtstr
(db:step-get-stepname x)
(db:step-get-state x)
(db:step-get-status x)
(time->string
(seconds->local-time
(db:step-get-event_time x)))))
(db-get-test-steps-for-run *db* test-id)))
"\n")))
(iup:attribute-set! stepslbl "TITLE" newtxt)))))
(hash-table-keys *examine-test-dat*))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
(take-right *allruns* numruns)
(pad-list *allruns* numruns)))
(lftcol (vector-ref uidat 0))
(tableheader (vector-ref uidat 1))
(table (vector-ref uidat 2))
(coln 0))
(update-labels uidat)
(set! *alltestnamelst* '())
(for-each
(lambda (rundat)
(if (not rundat) ;; handle padded runs
;; ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
(set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
(let* ((run (vector-ref rundat 0))
|
348
349
350
351
352
353
354
355
356
357
358
359
360
361
|
(res '()))
(cond
((>= testnum ntests)
;; now lftlst will be an hbox with the test keys and the test name labels
(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
(else
(let ((labl (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))
(vector-set! lftcol testnum labl)
(loop (+ testnum 1)(cons labl res))))))
;;
(let loop ((runnum 0)
(keynum 0)
(keyvec (make-vector nkeys))
(res '()))
|
>
>
|
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
|
(res '()))
(cond
((>= testnum ntests)
;; now lftlst will be an hbox with the test keys and the test name labels
(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
(else
(let ((labl (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))
(iup:attribute-set! labl "ACTION" (lambda (obj)
(toggle-hide (iup:attribute obj "TITLE"))))
(vector-set! lftcol testnum labl)
(loop (+ testnum 1)(cons labl res))))))
;;
(let loop ((runnum 0)
(keynum 0)
(keyvec (make-vector nkeys))
(res '()))
|