Megatest

Changes On Branch 1624c400a9716477
Login

Changes In Branch v1.80-processes Through [1624c400a9] Excluding Merge-Ins

This is equivalent to a diff from 4f1a1fc90c to 1624c400a9

2023-10-24
12:40
merged fork check-in: e51e15945e user: mmgraham tags: v1.80
2023-10-19
18:55
changed a debug msg to level2, increased delay from 0.5 to 2 secs Leaf check-in: 60b31fb56a user: mmgraham tags: v1.80-processes
16:09
moved make-tmpdir-name into commonmod check-in: 1624c400a9 user: mmgraham tags: v1.80-processes
15:39
covered case where megatest.sh does not exist check-in: 4f1a1fc90c user: mmgraham tags: v1.80
14:58
consolidated tmp dir name functions to common:make-tmpdir-name. Adjusted server start delays and debug messages check-in: 900e9ce98b user: mmgraham tags: v1.80

Modified common.scm from [c00500b3f7] to [0854266963].

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
39
40
41
42
43
44
45







46
47
48
49
50
51
52







-
-
-
-
-
-
-







(import commonmod
	debugprint
	rmtmod
	(prefix mtargs args:))

(include "common_records.scm")

(define (common:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))

(define (remove-files filespec)
  (let ((files (glob filespec)))
    (for-each delete-file files)))

(define (stop-the-train)
  (thread-start! (make-thread (lambda ()
				(let loop ()

Modified commonmod.scm from [7e88abb9dd] to [5c1deb5d33].

158
159
160
161
162
163
164







165
166
167
168
169
170
171
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178







+
+
+
+
+
+
+







    (if valstr
	(val->alist valstr)
	'()))) ;; should it return empty list or #f to indicate not set?


(define (get-section cfgdat section)
  (hash-table-ref/default cfgdat section '()))

(define (common:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))

;; dot-locking egg seems not to work, using this for now
;; if lock is older than expire-time then remove it and try again
;; to get the lock
;;
(define (common:simple-file-lock fname #!key (expire-time 300))
  (let* ((lock-exists (file-exists? fname))