| ︙ | | |
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
|
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
|
-
+
|
;; res)))
;; (if (null? tal)
;; (reverse new-res)
;; (loop (car tal)(cdr tal) new-res)))))
;; runstmp))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table))
(dmode (let ((d (args:get-arg "-dumpmode")))
(dmode (let ((d (args:get-arg "-dumpmode"))) ;; json, sexpr
(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 (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")))
(cons "tests" db:test-record-fields) ;; "id" "testname" "test_path")
(list "steps" "id" "stepname"))))
|
| ︙ | | |
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
|
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
|
-
+
|
(string-intersperse adj-tests-spec ",")
;; db:test-record-fields
#f)
#f
'normal)
'())))
(case dmode
((json ods)
((json ods sexpr)
(if runs-spec
(for-each
(lambda (field-name)
(mutils:hierhash-set! data (conc (db:get-value-by-header run header field-name)) targetstr runname "meta" field-name))
runs-spec)))
;; (mutils:hierhash-set! data (db:get-value-by-header run header "status") targetstr runname "meta" "status" )
;; (mutils:hierhash-set! data (db:get-value-by-header run header "state") targetstr runname "meta" "state" )
|
| ︙ | | |
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
|
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
|
-
+
|
(final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-get-final_logf test))
(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test))
(fullname (conc testname
(if (equal? itempath "")
""
(conc "(" itempath ")")))))
(case dmode
((json ods)
((json ods sexpr)
(if tests-spec
(for-each
(lambda (field-name)
(mutils:hierhash-set! data (get-value-by-fieldname test test-field-index field-name) targetstr runname "data" (conc test-id) field-name))
tests-spec)))
;; ;; (mutils:hierhash-set! data fullname targetstr runname "data" (conc test-id) "tname" )
;; (mutils:hierhash-set! data testname targetstr runname "data" (conc test-id) "testname" )
|
| ︙ | | |
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
|
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
|
+
-
+
+
|
((cond
((and (number? first)(number? second)) <)
((and (string? first)(string? second)) string<=?)
(else equal?))
first second))))
tests))))))
runs)
(case dmode
(if (eq? dmode 'json)(json-write data))
((json) (json-write data))
((sexpr) (pp (common:to-alist data))))
(let* ((metadat-fields (delete-duplicates
(append keys '( "runname" "time" "owner" "pass_count" "fail_count" "state" "status" "comment" "id"))))
(run-fields '(
"testname"
"item_path"
"state"
"status"
|
| ︙ | | |
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
|
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
|
-
+
|
;; (print "Target: " target "/" runname " tests:")
;; (pp tests)
(cons (conc target "/" runname)
(cons (list (conc target "/" runname))
(cons '()
(cons run-fields tests)))))
(begin
(debug:print 0 *default-log-port* "WARNING: run " target "/" runname " appears to have no data")
(debug:print 4 *default-log-port* "WARNING: run " target "/" runname " appears to have no data")
;; (pp rundat)
'()))))
runsdat)
'())))
newdat)) ;; we use newdat to get target
(sheets (filter (lambda (x)
(not (null? x)))
|
| ︙ | | |