Megatest

Diff
Login

Differences From Artifact [afc7c13a07]:

To Artifact [06320fbe28]:


73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87







-
+







(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
     readline apropos json http-client directory-utils typed-records
     http-client srfi-18 extras format)
     http-client srfi-18 extras format tcp-server tcp)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(require-library mutils)

379
380
381
382
383
384
385

386
387
388
389
390
391
392
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393







+







			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
			"-var"
			"-dumpmode"
			"-run-id"
			"-db"
			"-ping"
			"-refdb2dat"
			"-o"
			"-log"
                        "-sync-log"
			"-since"
			"-fields"
926
927
928
929
930
931
932
933
934



935
936
937
938
939
940

941
942
943
944
945
946
947
927
928
929
930
931
932
933


934
935
936
937
938
939
940
941

942
943
944
945
946
947
948
949







-
-
+
+
+





-
+







;; 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
;;======================================================================

;; Server? Start up here.
;;
(if (args:get-arg "-server")
    (let* ((run-id (args:get-arg-number "-run-id"))
	   (tl        (launch:setup)))
    (let* ((run-id     (args:get-arg "-run-id"))
	   (dbfname    (args:get-arg "-db"))
	   (tl         (launch:setup)))
      (case (rmt:transport-mode)
	((http)(http-transport:launch))
	((tcp)
	 (debug:print 0 *default-log-port* "INFO: Running using tcp method.")
	 (if run-id
	     (tt:start-server tl run-id (dbmod:run-id->dbfname run-id) api:dispatch-request)
	     (tt:start-server tl run-id dbfname api:dispatch-request)
	     (begin
	       (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
	       (exit 1))))
	(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
      (set! *didsomething* #t)))

;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to