388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
transport-from-cmdinfo
transport-from-config
"fs"))))
(debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo)
(case chosen-transport
((http)
(set! *transport-type 'http)
(if run-id (server:ensure-running run-id))
(client:launch run-id))
(else ;; (fs)
(debug:print 0 "ERROR: Should NOT be getting here! fs transport is no longer supported")
(set! *transport-type* 'fs)
(set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
|
>
>
>
>
|
|
>
>
>
>
|
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
|
transport-from-cmdinfo
transport-from-config
"fs"))))
(debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo)
(case chosen-transport
((http)
(set! *transport-type 'http)
;; if we have a run-id (why would we?) start the server for that run.
;; otherwise it is up to other calls to start the server(s) dynamically
(if run-id
(begin
(server:ensure-running run-id)
(client:launch run-id))
(begin
;; without run-id we'll start a server for "0"
(server:ensure-running 0)
(client:launch 0))))
(else ;; (fs)
(debug:print 0 "ERROR: Should NOT be getting here! fs transport is no longer supported")
(set! *transport-type* 'fs)
(set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
|
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
|
;; - if cannot access db > allowed disconnect time then kill job
(if (args:get-arg "-runtests")
(general-run-call
"-runtests"
"run a test"
(lambda (target runname keys keyvals)
;; Insert this run into the tasks queue
(open-run-close tasks:add tasks:open-db
"runtests"
user
target
runname
(args:get-arg "-runtests")
#f))))
;; (runs:run-tests target
;; runname
;; (args:get-arg "-runtests")
;; user
;; args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
|
;; - if cannot access db > allowed disconnect time then kill job
(if (args:get-arg "-runtests")
(general-run-call
"-runtests"
"run a test"
(lambda (target runname keys keyvals)
;;
;; May or may not implement it this way ...
;;
;; Insert this run into the tasks queue
;; (open-run-close tasks:add tasks:open-db
;; "runtests"
;; user
;; target
;; runname
;; (args:get-arg "-runtests")
;; #f))))
(runs:run-tests target
runname
(args:get-arg "-runtests")
user
args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
|