| ︙ | | | ︙ | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
(declare (uses daemon))
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
|
>
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
(declare (uses daemon))
(declare (uses db))
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
|
| ︙ | | | ︙ | |
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
(if (args:get-arg "-version")
(begin
(print megatest-version)
(exit)))
(define *didsomething* #f)
;;======================================================================
;; Misc setup stuff
;;======================================================================
(debug:setup)
(if (args:get-arg "-logging")(set! *logging* #t))
|
>
>
>
>
>
|
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
(if (args:get-arg "-version")
(begin
(print megatest-version)
(exit)))
(define *didsomething* #f)
(if (and (or (args:get-arg "-list-targets")
(args:get-arg "-list-db-targets"))
(not (args:get-arg "-transport")))
(hash-table-set! args:arg-hash "-transport" "fs"))
;;======================================================================
;; Misc setup stuff
;;======================================================================
(debug:setup)
(if (args:get-arg "-logging")(set! *logging* #t))
|
| ︙ | | | ︙ | |
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
"-update-meta" "-extract-ods"))))
(if (setup-for-run)
(let loop ((servers (open-run-close tasks:get-best-server tasks:open-db))
(trycount 0))
(if (or (not servers)
(null? servers))
(begin
(if (eq? trycount 0) ;; just do the server start once
(begin
(debug:print 0 "INFO: Starting server as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
;; (process-run (car (argv)) (list "-server" "-" "-daemonize" "-transport" (args:get-arg "-transport" "http")))
(process-fork (lambda ()
(daemon:ize)
(server:launch (string->symbol (args:get-arg "-transport" "http")))))
(thread-sleep! 3))
(debug:print-info 0 "Waiting for server to start"))
(loop (open-run-close tasks:get-best-server tasks:open-db)
(+ trycount 1)))
(debug:print 0 "INFO: Server(s) running " servers)
)))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (setup-for-run)))
(if tl
|
|
>
>
>
>
>
|
|
|
<
>
>
|
>
>
|
|
>
|
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
|
"-update-meta" "-extract-ods"))))
(if (setup-for-run)
(let loop ((servers (open-run-close tasks:get-best-server tasks:open-db))
(trycount 0))
(if (or (not servers)
(null? servers))
(begin
(if (even? trycount) ;; just do the server start every other time through this loop (every 8 seconds)
(begin
(debug:print 0 "INFO: Starting server as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
;; no need to use fork, no need to do the list-servers trick. Just start the damn server, it will exit on it's own
;; if there is an existing server
(system "megatest -server - -daemonize")
(thread-sleep! 3)
;; (process-run (car (argv)) (list "-server" "-" "-daemonize" "-transport" (args:get-arg "-transport" "http")))
;; (system (conc "megatest -list-servers | egrep '" megatest-version ".*alive' || megatest -server - -daemonize && sleep 3"))
;; (process-fork (lambda ()
;; (daemon:ize)
;; (server:launch (string->symbol (args:get-arg "-transport" "http")))))
)
(begin
(debug:print-info 0 "Waiting for server to start")
(thread-sleep! 4)))
(if (< trycount 10)
(loop (open-run-close tasks:get-best-server tasks:open-db)
(+ trycount 1))
(debug:print 0 "WARNING: Couldn't start or find a server.")))
(debug:print 0 "INFO: Server(s) running " servers)
)))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (setup-for-run)))
(if tl
|
| ︙ | | | ︙ | |
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
|
(args:get-arg ":state")
(args:get-arg ":status")
(args:get-arg "-setlog")
(args:get-arg "-m"))
;; (if db (sqlite3:finalize! db))
(set! *didsomething* #t)))
(if (or (and (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status
(not (args:get-arg "-step"))) ;; -setlog may have been processed already in the "-step" previous
(args:get-arg "-set-toplog")
(args:get-arg "-test-status")
(args:get-arg "-set-values")
(args:get-arg "-load-test-data")
(args:get-arg "-runstep")
(args:get-arg "-summarize-items"))
(if (not (getenv "MT_CMDINFO"))
|
|
|
>
|
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
|
(args:get-arg ":state")
(args:get-arg ":status")
(args:get-arg "-setlog")
(args:get-arg "-m"))
;; (if db (sqlite3:finalize! db))
(set! *didsomething* #t)))
(if (or (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status
;; (not (args:get-arg "-step"))) ;; -setlog may have been processed already in the "-step" previous
;; NEW POLICY - -setlog sets test overall log on every call.
(args:get-arg "-set-toplog")
(args:get-arg "-test-status")
(args:get-arg "-set-values")
(args:get-arg "-load-test-data")
(args:get-arg "-runstep")
(args:get-arg "-summarize-items"))
(if (not (getenv "MT_CMDINFO"))
|
| ︙ | | | ︙ | |