| ︙ | | | ︙ | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
>
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(declare (uses ezsteps))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
| ︙ | | | ︙ | |
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
(define (dashboard-tests:run-html-viewer lfilename)
(let ((htmlviewercmd (configf:lookup *configdat* "setup" "htmlviewercmd")))
(if htmlviewercmd
(system (conc "(" htmlviewercmd " " lfilename " ) &"))
(iup:send-url lfilename))))
(define (dashboard-tests:run-a-step
(define (dashboard-tests:step-run-control test-id stepname teststeps)
(iup:dialog ;; #:close_cb (lambda (a)(exit)) ; #:expand "YES"
#:title stepname
(iup:vbox ; #:expand "YES"
(iup:label (conc "Step: " stepname "\nNB// These buttons only run the test step\nfor the purpose of debugging.\nNot all database updates are done."))
(iup:button "Re-run"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(print "Rerun " stepname)))
(iup:button "Re-run and continue"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(let ((inprocess #f))
(for-each
(lambda (stepn)
(let ((curr-step-name (vector-ref stepn 0)))
(if (equal? curr-step-name stepname)(set! inprocess #t))
(if inprocess (print "Continue " curr-step-name))))
teststeps))))
|
|
>
|
|
<
<
<
<
<
<
|
|
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
(define (dashboard-tests:run-html-viewer lfilename)
(let ((htmlviewercmd (configf:lookup *configdat* "setup" "htmlviewercmd")))
(if htmlviewercmd
(system (conc "(" htmlviewercmd " " lfilename " ) &"))
(iup:send-url lfilename))))
(define (dashboard-tests:run-a-step info)
#t)
(define (dashboard-tests:step-run-control testdat stepname testconfig)
(iup:dialog ;; #:close_cb (lambda (a)(exit)) ; #:expand "YES"
#:title stepname
(iup:vbox ; #:expand "YES"
(iup:label (conc "Step: " stepname "\nNB// These buttons only run the test step\nfor the purpose of debugging.\nNot all database updates are done."))
(iup:button "Re-run"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(ezsteps:run-from testdat stepname #f)))
(iup:button "Re-run and continue"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(ezsteps:run-from testdat stepname #f)))
;; (iup:button "Refresh test data"
;; #:expand "HORIZONTAL"
;; #:action (lambda (obj)
;; (print "Refresh test data " stepname))
)))
;;======================================================================
|
| ︙ | | | ︙ | |
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
;; These next two are intentional bad values to ensure errors if they should not
;; get filled in properly.
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found
|
|
|
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
;; These next two are intentional bad values to ensure errors if they should not
;; get filled in properly.
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found
(teststeps (if testdat (db:get-compressed-steps test-id work-area: rundir) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
(testmeta (if testdat
(let ((tm (open-run-close db:testmeta-get-record #f testname)))
(if tm tm (make-db:testmeta)))
(make-db:testmeta)))
|
| ︙ | | | ︙ | |
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
;; (if (equal? col 6)
(let* ((mtrx-rc (conc lin ":" 6))
(fname (iup:attribute obj mtrx-rc))) ;; col))))
(if (eq? col 6)
(view-a-log fname)
(iup:show
(dashboard-tests:step-run-control
test-id
(iup:attribute obj (conc lin ":" 1))
teststeps))))))))
;; (let loop ((count 0))
;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count))
;; (if (< count 30)
;; (loop (+ count 1))))
(iup:attribute-set! steps-matrix "0:1" "Step Name")
|
|
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
;; (if (equal? col 6)
(let* ((mtrx-rc (conc lin ":" 6))
(fname (iup:attribute obj mtrx-rc))) ;; col))))
(if (eq? col 6)
(view-a-log fname)
(iup:show
(dashboard-tests:step-run-control
testdat
(iup:attribute obj (conc lin ":" 1))
teststeps))))))))
;; (let loop ((count 0))
;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count))
;; (if (< count 30)
;; (loop (+ count 1))))
(iup:attribute-set! steps-matrix "0:1" "Step Name")
|
| ︙ | | | ︙ | |