| ︙ | | |
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
+
|
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(declare (uses ezsteps))
(declare (uses sdb))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
| ︙ | | |
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
-
+
|
(db:test-get-status testdat))))
(iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
lbl)
(store-label "testcomment"
(iup:label "TestComment "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-comment testdat)))
(sdb:qry 'getstr (db:test-get-comment testdat))))
(store-label "testid"
(iup:label "TestId "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-id testdat)))
(store-label "testdate"
(iup:label "TestDate "
|
| ︙ | | |
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
-
+
-
+
|
"Run duration: "
"Logfile: "))
(iup:label "" #:expand "VERTICAL")))
(apply iup:vbox ; #:expand "YES"
(list
;; NOTE: Yes, the host can change!
(store-label "HostName"
(iup:label (db:test-get-host testdat) #:expand "HORIZONTAL")
(iup:label (sdb:qry 'getstr (db:test-get-host testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-host testdat)))
(store-label "Uname"
(iup:label " " #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-uname testdat)))
(lambda (testdat)(sdb:qry 'getstr (db:test-get-uname testdat))))
(store-label "DiskFree"
(iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-diskfree testdat))))
(store-label "CPULoad"
(iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-cpuload testdat))))
(store-label "RunDuration"
|
| ︙ | | |
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
-
+
|
(debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
(open-run-close db:get-test-info-by-id db test-id )))))
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (db:get-compressed-steps test-id work-area: rundir))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir (db:test-get-rundir testdat))
(set! rundir (sdb:qry 'getstr (db:test-get-rundir testdat)))
(set! testfullname (db:test-get-fullname testdat))
;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n "))
(if (eq? curr-mod-time db-mod-time) ;; do only once if same
(set! db-mod-time (+ curr-mod-time 1))
(set! db-mod-time curr-mod-time))
(set! last-update (current-milliseconds))
(set! request-update #f) ;; met the need ...
|
| ︙ | | |