183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
"-gui"
;; misc
"-archive"
"-repl"
"-lock"
"-unlock"
"-list-servers"
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests
"-remove-runs"
"-usequeue"
"-rebuild-db"
|
>
>
>
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
"-gui"
;; misc
"-archive"
"-repl"
"-lock"
"-unlock"
"-list-servers"
;; mist queries
"-list-disks"
"-list-targets"
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests
"-remove-runs"
"-usequeue"
"-rebuild-db"
|
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
;; Misc general calls
;;======================================================================
(if (args:get-arg "-env2file")
(begin
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
;;======================================================================
;; 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")
(begin
(debug:print 1 "Launching server...")
(server:launch)))
(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))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
;; Misc general calls
;;======================================================================
(if (args:get-arg "-env2file")
(begin
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
;; (if (args:get-arg "-list-targets")
;; (print (string-intersperse
;; (sort (map car (hash-table->alist
;; (read-config "runconfigs.config"
;; (make-hash-table) #f))) string<?) "\n")))
;;
;;
;; (if (args:get-arg "-list-disks")
;; (print (string-intersperse
;; (map cadr (hash-table-ref/default
;; (read-config "megatest.config" #f #t)
;; "disks" "'"
;; ("none" ""))) "\n")))
;;======================================================================
;; 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")
(begin
(debug:print 2 "Launching server...")
(server:launch)))
(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))
|