Overview
Context
Changes
Modified dashboard.scm
from [7571891dc8]
to [a2d381ad1b].
| ︙ | | |
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
|
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
|
-
+
|
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
(iup:attribute-set! tb "VALUE" val)
(dboard:data-set-run-name! *data* val)
(dashboard:update-run-command))))
(refresh-runs-list (lambda ()
(let* ((target (dboard:data-get-target-string *data*))
(runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f))
(runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
(runs-header (vector-ref runs-for-targ 0))
(runs-dat (vector-ref runs-for-targ 1))
(run-names (cons default-run-name
(map (lambda (x)
(db:get-value-by-header x runs-header "runname"))
runs-dat))))
(iup:attribute-set! lb "REMOVEITEM" "ALL")
|
| ︙ | | |
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
|
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
|
-
+
|
(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))
(let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #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" "%/%")
(hash-table-keys *state-ignore-hash*) ;; '()
(hash-table-keys *status-ignore-hash*) ;; '()
#f #f
|
| ︙ | | |
Modified db.scm
from [165209a3bd]
to [0889d6ee03].
| ︙ | | |
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
|
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
|
-
-
+
+
|
;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; to extract info from the structure returned
;;
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
(let* ((tmp (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit fields) ;; test-name)
(let* ((tmp (runs:get-std-run-fields keys (or fields '("id" "runname" "state" "status" "owner" "event_time"))))
(keystr (car tmp))
(header (cadr tmp))
(res '())
(key-patt "")
(runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
(qry-str #f)
(keyvals (if targpatt (keys:target->keyval keys targpatt) '())))
|
| ︙ | | |
Modified megatest.scm
from [2f68dfa905]
to [c1a7cb4489].
| ︙ | | |
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
|
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
|
-
-
+
+
|
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(runpatt (args:get-arg "-list-runs"))
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (db:get-keys dbstruct))
;; (runsda t (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f))
(runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target)
#f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
(runstmp (db:get-rows runsdat))
(header (db:get-header runsdat))
(runs (if (and (not (null? runstmp))
(args:get-arg "-since"))
(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
(let loop ((hed (car runstmp))
(tal (cdr runstmp))
|
| ︙ | | |
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
|
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
|
-
-
-
+
+
+
|
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table))
(dmode (let ((d (args:get-arg "-dumpmode")))
(if d (string->symbol d) #f)))
(data (make-hash-table))
(fields-spec (if (args:get-arg "-fields")
(extract-fields-constraints (args:get-arg "-fields"))
'(("runs" "id" "target" "runname")
(cons "tests" db:test-record-fields) ;; "id" "testname" "test_path")
("steps" "id" "stepname"))))
(list (list "runs" "id" "target" "runname")
(cons "tests" db:test-record-fields) ;; "id" "testname" "test_path")
(list "steps" "id" "stepname"))))
(runs-spec (let ((r (alist-ref "runs" fields-spec equal?)))
(if (and r (not (null? r))) r (list "id"))))
(tests-spec (let ((t (alist-ref "tests" fields-spec equal?)))
(if (and t (null? t)) ;; all fields
db:test-record-fields
t)))
(adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id"))))
|
| ︙ | | |
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
|
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
|
-
+
|
(begin
(hash-table-set! seen targetstr #t)
;; (print "[" targetstr "]"))))
(if (not dmode)(print targetstr))))
(let* ((run-id (db:get-value-by-header run header "id"))
(runname (db:get-value-by-header run header "runname"))
(tests (if tests-spec
(db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc
(rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc
;; use qryvals if test-spec provided
(if tests-spec
(string-intersperse adj-tests-spec ",")
;; db:test-record-fields
#f))
'())))
(case dmode
|
| ︙ | | |
Modified mt.scm
from [82ea79d650]
to [a598f8fbca].
| ︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
-
+
-
+
|
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; to extract info from the structure returned
;;
(define (mt:get-runs-by-patt keys runnamepatt targpatt)
(let loop ((runsdat (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500))
(let loop ((runsdat (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500 #f))
(res '())
(offset 0)
(limit 500))
;; (print "runsdat: " runsdat)
(let* ((header (vector-ref runsdat 0))
(runslst (vector-ref runsdat 1))
(full-list (append res runslst))
(have-more (eq? (length runslst) limit)))
;; (debug:print 0 "header: " header " runslst: " runslst " have-more: " have-more)
(if have-more
(let ((new-offset (+ offset limit))
(next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)))
(next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit #f)))
(debug:print-info 4 "More than " limit " runs, have " (length full-list) " runs so far.")
(debug:print-info 0 "next-batch: " next-batch)
(loop next-batch
full-list
new-offset
limit))
(vector header full-list)))))
|
| ︙ | | |
Modified rmt.scm
from [9a3ff4c76e]
to [6f34e37f07].
| ︙ | | |
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
|
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
|
-
-
+
+
|
(define (rmt:set-run-status run-id run-status #!key (msg #f))
(rmt:send-receive 'set-run-status #f (list run-id run-status msg)))
(define (rmt:update-run-event_time run-id)
(rmt:send-receive 'update-run-event_time #f (list run-id)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields) ;; fields of #f uses default
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields)))
(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
(if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
(rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))))
;;======================================================================
;; M U L T I R U N Q U E R I E S
|
| ︙ | | |