943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
|
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
|
-
+
-
-
-
+
+
+
+
+
+
+
|
(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")
("tests" "id" "testname" "test_path")
(cons "tests" db:test-record-fields) ;; "id" "testname" "test_path")
("steps" "id" "stepname"))))
(runs-spec (alist-ref "runs" fields-spec equal?))
(tests-spec (alist-ref "tests" fields-spec equal?))
(adj-tests-spec (delete-duplicates (cons "id" tests-spec)))
(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"))))
(steps-spec (alist-ref "steps" fields-spec equal?))
(test-field-index (make-hash-table)))
(if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec
(let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec)))
(if (null? invalid-tests-spec)
;; generate the lookup map test-field-name => index-number
(let loop ((hed (car adj-tests-spec))
|
983
984
985
986
987
988
989
990
991
992
993
994
995
996
|
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
|
+
|
(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
((json)
(if runs-spec
(for-each
(lambda (field-name)
|