95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(db:string->obj res)
;; (if (< attemptnum 100)
;; (begin
;; (hash-table-delete! *runremote* run-id)
;; (thread-sleep! 0.5)
;; (rmt:send-receive cmd rid params attempnum: (+ attemptnum 1)))
;; (begin
;; (print-call-chain)
;; (debug:print 0 "ERROR: too many attempts to communicate have failed. Giving up. Kill your mtest processes and start over")
;; (exit 1)))))
(begin ;; let ((new-connection-info (client:setup run-id)))
(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; no longer killing the server in http-transport:client-api-send-receive
|
|
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(db:string->obj res)
;; (if (< attemptnum 100)
;; (begin
;; (hash-table-delete! *runremote* run-id)
;; (thread-sleep! 0.5)
;; (rmt:send-receive cmd rid params attempnum: (+ attemptnum 1)))
;; (begin
;; (print-call-chain (current-error-port))
;; (debug:print 0 "ERROR: too many attempts to communicate have failed. Giving up. Kill your mtest processes and start over")
;; (exit 1)))))
(begin ;; let ((new-connection-info (client:setup run-id)))
(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; no longer killing the server in http-transport:client-api-send-receive
|
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
|
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
(define (rmt:get-test-info-by-id run-id test-id)
(if (and (number? run-id)(number? test-id))
(rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id))
(begin
(debug:print 0 "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain)
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
(rmt:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id)))
(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
|
|
|
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
|
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
(define (rmt:get-test-info-by-id run-id test-id)
(if (and (number? run-id)(number? test-id))
(rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id))
(begin
(debug:print 0 "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain (current-error-port))
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
(rmt:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id)))
(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
(let* ((test-path (if (string? work-area)
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(rmt:send-receive 'set-tests-state-status run-id (list run-id testnames currstate currstatus newstate newstatus)))
(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)
(if (number? run-id)
(rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))
(begin
(debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id)
(print-call-chain)
'())))
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
(let ((run-id-list (if run-ids
run-ids
(rmt:get-all-run-ids))))
(apply append (map (lambda (run-id)
|
|
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(rmt:send-receive 'set-tests-state-status run-id (list run-id testnames currstate currstatus newstate newstatus)))
(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)
(if (number? run-id)
(rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))
(begin
(debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id)
(print-call-chain (current-error-port))
'())))
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
(let ((run-id-list (if run-ids
run-ids
(rmt:get-all-run-ids))))
(apply append (map (lambda (run-id)
|