| ︙ | | |
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
+
|
(remote-conndat-set! runremote #f) ;; invalidate the connection, thus forcing a new connection.
(mutex-unlock! *rmt-mutex*)
(rmt:send-receive cmd rid params attemptnum: attemptnum))
;;DOT CASE5 [label="local\nread"];
;;DOT MUTEXLOCK -> CASE5 [label="server not required,\non homehost,\nread-only query"]; {rank=same "case 5" CASE5};
;;DOT CASE5 -> "rmt:open-qry-close-locally";
;; on homehost and this is a read
((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
(cdr (remote-hh-dat runremote)) ;; on homehost
(member cmd api:read-only-queries)) ;; this is a read
(mutex-unlock! *rmt-mutex*)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 5")
(rmt:open-qry-close-locally cmd 0 params))
|
| ︙ | | |
497
498
499
500
501
502
503
504
505
506
507
508
509
510
|
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
|
+
+
+
+
|
res)))
(define (rmt:get-targets)
(rmt:send-receive 'get-targets #f '()))
(define (rmt:get-target run-id)
(rmt:send-receive 'get-target run-id (list run-id)))
(define (rmt:get-run-times runpatt targetpatt)
(rmt:send-receive 'get-run-times #f (list runpatt targetpatt )))
;;======================================================================
;; T E S T S
;;======================================================================
;; Just some syntatic sugar
(define (rmt:register-test run-id test-name item-path)
|
| ︙ | | |
548
549
550
551
552
553
554
555
556
557
558
559
560
561
|
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
|
+
+
+
|
;; (print-call-chain (current-error-port))
;; '())))
;; get stuff via synchash
(define (rmt:synchash-get run-id proc synckey keynum params)
(rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params)))
(define (rmt:get-tests-for-run-mindata run-id testpatt states status not-in)
(rmt:send-receive 'get-tests-for-run-mindata run-id (list run-id testpatt states status not-in)))
;; IDEA: Threadify these - they spend a lot of time waiting ...
;;
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
(let ((multi-run-mutex (make-mutex))
(run-id-list (if run-ids
run-ids
(rmt:get-all-run-ids)))
|
| ︙ | | |
675
676
677
678
679
680
681
682
683
684
685
686
687
688
|
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
|
+
+
+
|
(define (rmt:top-test-set-per-pf-counts run-id test-name)
(rmt:send-receive 'top-test-set-per-pf-counts run-id (list run-id test-name)))
(define (rmt:get-raw-run-stats run-id)
(rmt:send-receive 'get-raw-run-stats run-id (list run-id)))
(define (rmt:get-test-times runname target)
(rmt:send-receive 'get-test-times #f (list runname target )))
;;======================================================================
;; R U N S
;;======================================================================
(define (rmt:get-run-info run-id)
(rmt:send-receive 'get-run-info run-id (list run-id)))
|
| ︙ | | |