Megatest

Diff
Login

Differences From Artifact [020e1b8ba1]:

To Artifact [f24c5b91ed]:


585
586
587
588
589
590
591
592
593


594
595
596
597
598
599
600
601
585
586
587
588
589
590
591


592
593

594
595
596
597
598
599
600







-
-
+
+
-







;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
    (handle-exceptions
	exn
	(begin
	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
      (begin
	(print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
	  )
      (let* ((tl   (or (args:get-arg "-log")(launch:setup)))   ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
	     (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
		       (conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
	     (oup  (open-logfile logf)))
	(if (not (args:get-arg "-log"))
	    (hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
	(debug:print-info 0 *default-log-port* "Sending log output to " logf)
921
922
923
924
925
926
927

928

929
930
931
932







933
934
935
936
937
938
939
920
921
922
923
924
925
926
927

928
929
930


931
932
933
934
935
936
937
938
939
940
941
942
943
944







+
-
+


-
-
+
+
+
+
+
+
+







;; 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"))
    (let ((tl        (launch:setup)))
	   (tl        (launch:setup)))
      (case (rmt:transport-mode)
	((http)(http-transport:launch))
	((tcp) (tt:start-server tl))
	(else (debug:print 0 "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
	((tcp)
	 (if run-id
	     (tt:start-server tl (dbmod:run-id->dbfname run-id))
	     (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
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
    (begin