216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
"-show-runconfig"
"-show-config"
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests
"-remove-runs"
"-usequeue"
|
<
|
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
"-show-runconfig"
"-show-config"
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests
"-remove-runs"
"-rebuild-db"
"-rollup"
"-update-meta"
"-gen-megatest-area"
"-logging"
"-v" ;; verbose 2, more than normal (normal is 1)
|
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(let ((transport (args:get-arg "-transport" "http")))
(debug:print 2 "Launching server using transport " transport)
(server:launch (string->symbol transport))))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a~10a\n")
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(let ((transport (args:get-arg "-transport" "http")))
(debug:print 2 "Launching server using transport " transport)
(server:launch (string->symbol transport)))
(if (not (null? (lset-intersection
equal?
(hash-table-keys args:arg-hash)
'("-runtests" "-list-runs" "-rollup"
"-remove-runs" "-lock" "-unlock"
"-update-meta" "-extract-ods"))))
(if (setup-for-run)
(let ((servers (open-run-close tasks:get-best-server tasks:open-db)))
(if (or (not servers)
(null? servers))
(begin
(debug:print 0 "INFO: Starting server as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
(system (conc (car (argv)) " -server - -transport " (args:get-arg "-transport" "http")))
(thread-sleep! 3)) ;; give the server a few seconds to start
(debug:print 0 "INFO: Servers already running " servers)
)))))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a~10a\n")
|