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))
(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))
|
|
|
|
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 (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
|
(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"))))
(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"))))
|
|
|
|
|
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"))
(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
|
(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
;; use qryvals if test-spec provided
(if tests-spec
(string-intersperse adj-tests-spec ",")
;; db:test-record-fields
#f))
'())))
(case dmode
|
|
|
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
(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
|