︙ | | | ︙ | |
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
|
(run-matrix (iup:matrix
#:expand "YES"
#:click-cb
(lambda (obj lin col status)
(let* ((toolpath (car (argv)))
(key (conc lin ":" col))
(test-id (hash-table-ref/default cell-lookup key -1))
(cmd (conc toolpath " -test " test-id "&")))
(system cmd)))))
(updater (lambda ()
(let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(run-id (dboard:data-get-curr-run-id *data*))
(tests-dat (let ((tdat (db:get-tests-for-run db run-id
(hash-table-ref/default *searchpatts* "test-name" "%/%")
|
|
|
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
|
(run-matrix (iup:matrix
#:expand "YES"
#:click-cb
(lambda (obj lin col status)
(let* ((toolpath (car (argv)))
(key (conc lin ":" col))
(test-id (hash-table-ref/default cell-lookup key -1))
(cmd (conc toolpath " -test " (dboard:data-get-curr-run-id *data*) "," test-id "&")))
(system cmd)))))
(updater (lambda ()
(let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(run-id (dboard:data-get-curr-run-id *data*))
(tests-dat (let ((tdat (db:get-tests-for-run db run-id
(hash-table-ref/default *searchpatts* "test-name" "%/%")
|
︙ | | | ︙ | |
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
|
(let ((hideit (iup:button "HideTests" #:action (lambda (obj)
(set! *hide-not-hide* (not *hide-not-hide*))
(iup:attribute-set! obj "TITLE" (if *hide-not-hide* "HideTests" "NotHide"))
(mark-for-update)))))
(set! *hide-not-hide-button* hideit)
hideit))
(iup:hbox
(iup:button "Quit" #:action (lambda (obj)(if *dbstruct-local* (db:close-all *dbstruct-local*))(exit)))
(iup:button "Refresh" #:action (lambda (obj)
(mark-for-update)))
(iup:button "Collapse" #:action (lambda (obj)
(let ((myname (iup:attribute obj "TITLE")))
(if (equal? myname "Collapse")
(begin
(for-each (lambda (tname)
|
|
>
>
|
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
|
(let ((hideit (iup:button "HideTests" #:action (lambda (obj)
(set! *hide-not-hide* (not *hide-not-hide*))
(iup:attribute-set! obj "TITLE" (if *hide-not-hide* "HideTests" "NotHide"))
(mark-for-update)))))
(set! *hide-not-hide-button* hideit)
hideit))
(iup:hbox
(iup:button "Quit" #:action (lambda (obj)
;; (if *dbstruct-local* (db:close-all *dbstruct-local*))
(exit)))
(iup:button "Refresh" #:action (lambda (obj)
(mark-for-update)))
(iup:button "Collapse" #:action (lambda (obj)
(let ((myname (iup:attribute obj "TITLE")))
(if (equal? myname "Collapse")
(begin
(for-each (lambda (tname)
|
︙ | | | ︙ | |
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
|
(> modtime last-db-update-time)
(> (current-seconds)(+ last-db-update-time 1)))))
(define *monitor-db-path* (conc *dbdir* "/monitor.db"))
(define *last-monitor-update-time* 0)
;; Force creation of the db in case it isn't already there.
(let ((db (tasks:open-db)))
(sqlite3:finalize! db))
(define (dashboard:get-youngest-run-db-mod-time)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
(current-seconds)) ;; something went wrong - just print an error and return current-seconds
|
|
<
|
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
|
(> modtime last-db-update-time)
(> (current-seconds)(+ last-db-update-time 1)))))
(define *monitor-db-path* (conc *dbdir* "/monitor.db"))
(define *last-monitor-update-time* 0)
;; Force creation of the db in case it isn't already there.
(tasks:open-db)
(define (dashboard:get-youngest-run-db-mod-time)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
(current-seconds)) ;; something went wrong - just print an error and return current-seconds
|
︙ | | | ︙ | |
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
|
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
(if runid
(begin
(lambda (x)
(on-exit (lambda ()
(if *dbstruct-local* (db:close-all *dbstruct-local*))))
(examine-run *dbstruct-local* runid)))
(begin
(print "ERROR: runid is not a number " (args:get-arg "-run"))
(exit 1)))))
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (map string->number (string-split (args:get-arg "-test") ",")))
(run-id (car dat))
|
|
<
|
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
|
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
(if runid
(begin
(lambda (x)
(on-exit std-exit-procedure)
(examine-run *dbstruct-local* runid)))
(begin
(print "ERROR: runid is not a number " (args:get-arg "-run"))
(exit 1)))))
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (map string->number (string-split (args:get-arg "-test") ",")))
(run-id (car dat))
|
︙ | | | ︙ | |