161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
(common:del-remote! remote run-id)
;; (mutex-unlock! *send-receive-mutex*)
(if (and faststart (equal? faststart "no"))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
(begin
(server:kind-run run-id area-dat)
(rmt:open-qry-close-locally cmd run-id area-dat params))))
(begin
;; (debug:print 0 "ERROR: Communication failed!")
;; (mutex-unlock! *send-receive-mutex*)
;; (exit)
(rmt:open-qry-close-locally cmd run-id area-dat params)
)))))
|
>
>
>
>
>
>
|
|
|
>
>
>
>
>
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
(common:del-remote! remote run-id)
;; (mutex-unlock! *send-receive-mutex*)
(if (and faststart (equal? faststart "no"))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
(let ((start-time (current-milliseconds))
(max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
"300")))
(newres (rmt:open-qry-close-locally cmd run-id params)))
(let ((delta (- (current-milliseconds) start-time)))
(if (> delta max-query)
(begin
;; (server:kind-run run-id area-dat)
;; (rmt:open-qry-close-locally cmd run-id area-dat params))))
(debug:print-info 0 "Starting server as query time " delta " is over the limit of " max-query)
(server:kind-run run-id)))
;; return the result!
newres)
)))
(begin
;; (debug:print 0 "ERROR: Communication failed!")
;; (mutex-unlock! *send-receive-mutex*)
;; (exit)
(rmt:open-qry-close-locally cmd run-id area-dat params)
)))))
|
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
|
;;
(define (rmt:get-key-val-pairs run-id area-dat)
(rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat))
(define (rmt:get-keys area-dat)
(rmt:send-receive 'get-keys #f '() area-dat))
;;======================================================================
;; T E S T S
;;======================================================================
(define (rmt:get-test-id run-id testname item-path area-dat)
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat))
(define (rmt:get-test-info-by-id run-id test-id area-dat)
(if (and (number? run-id)(number? test-id))
(rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id) area-dat)
(begin
|
>
>
>
>
>
>
>
>
>
>
|
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
;;
(define (rmt:get-key-val-pairs run-id area-dat)
(rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat))
(define (rmt:get-keys area-dat)
(rmt:send-receive 'get-keys #f '() area-dat))
(define (rmt:get-key-vals run-id)
(rmt:send-receive 'get-key-vals #f (list run-id)))
(define (rmt:get-targets)
(rmt:send-receive 'get-targets #f '()))
;;======================================================================
;; T E S T S
;;======================================================================
;; Just some syntatic sugar NOTE: Need to add area-dat
(define (rmt:register-test run-id test-name item-path)
(rmt:general-call 'register-test run-id run-id test-name item-path))
(define (rmt:get-test-id run-id testname item-path area-dat)
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat))
(define (rmt:get-test-info-by-id run-id test-id area-dat)
(if (and (number? run-id)(number? test-id))
(rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id) area-dat)
(begin
|
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
(map (lambda (run-id)
(rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname) area-dat))
run-ids))))
(define (rmt:get-run-ids-matching keynames target res area-dat)
(rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat)
(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal)))
(rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode) area-dat))
(define (rmt:get-count-tests-running-for-run-id run-id area-dat)
(rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat))
;; Statistical queries
(define (rmt:get-count-tests-running run-id area-dat)
(rmt:send-receive 'get-count-tests-running run-id (list run-id) area-dat))
(define (rmt:get-count-tests-running-for-testname run-id testname area-dat)
(rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat))
(define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat)
(rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat))
(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status area-dat)
(rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path status) area-dat))
(define (rmt:update-pass-fail-counts run-id test-name area-dat)
(rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat))
;;======================================================================
;; R U N S
;;======================================================================
(define (rmt:get-run-info run-id area-dat)
(rmt:send-receive 'get-run-info run-id (list run-id) area-dat))
;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user area-dat)
(rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat))
(define (rmt:get-run-name-from-id run-id area-dat)
(rmt:send-receive 'get-run-name-from-id run-id (list run-id) area-dat))
|
|
|
>
>
|
|
>
>
>
|
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
|
(map (lambda (run-id)
(rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname) area-dat))
run-ids))))
(define (rmt:get-run-ids-matching keynames target res area-dat)
(rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat)
(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal))(itemmap #f))
(rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap) area-dat))
(define (rmt:get-count-tests-running-for-run-id run-id area-dat)
(rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat))
;; Statistical queries
(define (rmt:get-count-tests-running run-id area-dat)
(rmt:send-receive 'get-count-tests-running run-id (list run-id) area-dat))
(define (rmt:get-count-tests-running-for-testname run-id testname area-dat)
(rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat))
(define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat)
(rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat))
;; state and status are extra hints not usually used in the calculation
;;
(define (rmt:roll-up-pass-fail-counts run-id test-name item-path state status area-dat)
(rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path state status) area-dat))
(define (rmt:update-pass-fail-counts run-id test-name area-dat)
(rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat))
;;======================================================================
;; R U N S
;;======================================================================
(define (rmt:get-run-info run-id area-dat)
(rmt:send-receive 'get-run-info run-id (list run-id) area-dat))
(define (rmt:get-num-runs runpatt)
(rmt:send-receive 'get-num-runs #f (list runpatt)))
;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user area-dat)
(rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat))
(define (rmt:get-run-name-from-id run-id area-dat)
(rmt:send-receive 'get-run-name-from-id run-id (list run-id) area-dat))
|