333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
|
(debug:print-info 13 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " dat=" dat " runremote = " runremote)
(mutex-unlock! *rmt-mutex*)
(if success ;; success only tells us that the transport was
;; successful, have to examine the data to see if
;; there was a detected issue at the other end
(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
(begin
(debug:print-error 0 *default-log-port* " dat=" dat)
(extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params))
)))
(define (rmt:print-db-stats)
(let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
(debug:print 18 *default-log-port* "DB Stats\n========")
(debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
|
|
|
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
|
(debug:print-info 13 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " dat=" dat " runremote = " runremote)
(mutex-unlock! *rmt-mutex*)
(if success ;; success only tells us that the transport was
;; successful, have to examine the data to see if
;; there was a detected issue at the other end
(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
(begin
(debug:print-info 0 *default-log-port* "Bad return data from Megatest server: dat=" dat)
(extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params))
)))
(define (rmt:print-db-stats)
(let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
(debug:print 18 *default-log-port* "DB Stats\n========")
(debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
|
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
|
(all-dat (cdr run-dat))
(tests-data (alist-ref "data" all-dat equal?))
(run-meta (alist-ref "meta" all-dat equal?))
(run-id (string->number (alist-ref "id" run-meta equal?))))
(rmt:insert-run run-id target runname run-meta)
(if (list? tests-data)
(begin
(for-each
(lambda (test-dat)
(let* ((test-id (car test-dat))
(test-rec (cdr test-dat)))
(rmt:insert-test run-id test-rec)))
tests-data)
)
|
>
|
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
|
(all-dat (cdr run-dat))
(tests-data (alist-ref "data" all-dat equal?))
(run-meta (alist-ref "meta" all-dat equal?))
(run-id (string->number (alist-ref "id" run-meta equal?))))
(rmt:insert-run run-id target runname run-meta)
(if (list? tests-data)
(begin
(debug:print 0 *default-log-port* "Inserting " (length tests-data) " tests in run " runname)
(for-each
(lambda (test-dat)
(let* ((test-id (car test-dat))
(test-rec (cdr test-dat)))
(rmt:insert-test run-id test-rec)))
tests-data)
)
|
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
|
(item-path (alist-ref "item_path" test-rec equal?))
(test-id (rmt:get-test-id run-id testname item-path))
)
(if test-id
(debug:print 0 *default-log-port* "test "testname"/"item-path " already exists in run-id " run-id)
(begin
(debug:print 0 *default-log-port* " Insert test in run "run-id": "testname"/"item-path)
(rmt:send-receive 'insert-test run-id test-rec)
)
)
)
)
|
<
|
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
|
(item-path (alist-ref "item_path" test-rec equal?))
(test-id (rmt:get-test-id run-id testname item-path))
)
(if test-id
(debug:print 0 *default-log-port* "test "testname"/"item-path " already exists in run-id " run-id)
(begin
(rmt:send-receive 'insert-test run-id test-rec)
)
)
)
)
|