| ︙ | | |
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
|
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
|
-
+
+
|
(debug:print-info 1 "Killed server by pid at " hostname ":" port)))
;; (if zmq-socket (close-socket zmq-socket))
(format #t fmtstr id mt-ver pid hostname port start-time priority
status)))
servers)
(debug:print-info 1 "Done with listservers")
(exit) ;; must do, would have to add checks to many/all calls below
(set! *didsomething* #t))))
(set! *didsomething* #t))
(exit)))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
;; ping servers only if -runall -runtests
(let ((ping (args-defined? "-runall" "-runtests" "-remove-runs"
"-set-state-status" "-rerun" "-rollup" "-lock" "-unlock"
|
| ︙ | | |
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
-
-
+
+
|
(db:step-get-stepname step)
(db:step-get-state step)
(db:step-get-status step)
(db:step-get-event_time step)))
steps)))))
tests))))
runs)
(set! *didsomething* #t)
)))
(set! *didsomething* #t))
(exit)))
;;======================================================================
;; full run
;;======================================================================
;; get lock in db for full run for this directory
;; for all tests with deps
|
| ︙ | | |
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
|
;; else
;; put task in deferred queue
;; if still ok to run tasks
;; process deferred tasks per above steps
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
(let ((server-thread #f))
(if (args:get-arg "-server")
(let ((toppath (setup-for-run))
(db (open-db)))
(if db
(let* ((host:port (db:get-var db "SERVER")) ;; this doen't support multiple servers BUG!!!!
(th2 (server:start db (args:get-arg "-server")))
(th3 (make-thread (lambda ()
(server:keep-running db host:port)))))
(thread-start! th3)
(set! server-thread th3)))))
(general-run-call
"-runall"
"run all tests"
(lambda (target runname keys keynames keyvallst)
(runs:run-tests target
runname
(if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%/%")
user
args:arg-hash)))
(if server-thread
(thread-join! server-thread))))
|
| ︙ | | |
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
|
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
|
-
+
+
|
(server:client-setup))
(import readline)
(import apropos)
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))
(repl)))
(repl))
(exit))
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
;; this is the socket if we are a client
|
| ︙ | | |