16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
+
+
+
+
+
+
+
+
|
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit rmtmod))
(declare (uses debugprint))
;; (declare (uses debugprint.import))
(declare (uses commonmod))
;; (declare (uses commonmod.import))
(declare (uses dbfile)) ;; needed for records
(declare (uses dbmod))
;; (declare (uses tcp-transportmod))
;; (declare (uses tcp-transportmod.import))
;; (declare (uses apimod))
;; (declare (uses apimod.import))
;; (declare (uses ulex))
;; (include "ulex/ulex.scm")
(module rmtmod
*
(import scheme chicken data-structures extras matchable srfi-69)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import commonmod dbfile debugprint) ;; (prefix commonmod cmod:))
(import dbmod
;; tcp-transportmod
)
;; (import apimod)
;; (import (prefix ulex ulex:))
(include "db_records.scm")
(defstruct alldat
(areapath #f)
|
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
328
329
330
331
332
333
334
335
336
337
338
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
|
run-id test-id 'foo "COMPLETED" "DEAD"
"Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")))))))
;; call end of eud of run detection for posthook - from merge, is it needed?
;; (launch:end-of-run-check run-id)
all-ids)
)))))
;;======================================================================
;; Misc
;;======================================================================
;; (define (rmtmod:wait-on-server-load run-id ttdat)
;; (let* ((dbfname (dbmod:run-id->dbfname run-id))
;; (get-lowest-thread-load
;; (lambda ()
;; (let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
;; (car (map tt:get-server-threads sdats))))))
;; (if ttdat
;; (let loop ()
;; (if (> (get-lowest-thread-load) 5) ;; load is pretty high
;; (begin
;; (debug:print 0 *default-log-port* "Servers appear overloaded, waiting...")
;; (thread-sleep! 1)
;; (loop))))
;; (debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set"))))
)
|