136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
+
-
+
|
(assert (tt:valid-run-id run-id dbfname) "FATAL: invalid run-id "run-id)
(let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
(server-start-proc (lambda ()
(tt:server-process-run
(tt-areapath ttdat)
testsuite ;; (dbfile:testsuite-name)
(common:find-local-megatest)
dbfname ;; run-id
run-id))))
))))
(if conn
(begin
; (debug:print-info 0 *default-log-port* "already connected to the server")
conn) ;; we are already connected to the server
(let* ((sdat (tt:get-current-server-info ttdat dbfname)))
(match sdat
((host port start-time server-id pid dbfname2 servinffile)
|
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
|
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
|
-
+
+
+
-
+
|
bad-dat)))))))))
;; Given an area path, start a server process ### NOTE ### > file 2>&1
;; if the target-host is set
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
(define (tt:server-process-run areapath testsuite mtexe
dbfname ;; run-id
#!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
(assert areapath "FATAL: tt:server-process-run called without areapath defined.")
(assert testsuite "FATAL: tt:server-process-run called without testsuite defined.")
(assert mtexe "FATAL: tt:server-process-run called without mtexe defined.")
;; mtest -server - -m testsuite:ext-tests -db 6.db
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(let* (;; (dbfname (dbmod:run-id->dbfname run-id))
(load (get-normalized-cpu-load))
(trying (length (tt:find-server areapath dbfname)))
(nrun (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname))))
(cond
((> load 2.0)
(debug:print 0 *default-log-port* "Normalized load "load" on " (get-host-name) " is over the limit of 2.0. Not starting a server.")
(thread-sleep! 1))
|