Megatest

Changes On Branch 60b31fb56a3eb18a
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch v1.80-processes Excluding Merge-Ins

This is equivalent to a diff from 4f1a1fc90c to 60b31fb56a

2023-10-24
12:40
merged fork check-in: e51e15945e user: mmgraham tags: v1.80
2023-10-20
05:12
Merged fork

This node ran run-core-tests.sh through kill-rerun - a pretty good result. Dashboard comes up quickly also. check-in: e607892c7d user: mrwellan tags: v1.80

04:57
Merged fork check-in: 53900a0d02 user: mrwellan tags: v1.80-start-all
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))
︙

Modified tcp-transportmod.scm from [04adce729b] to [cc561d90e9].

︙
168
169
170
171
172
173
174
175

176
177
178
179
180
181
182

168
169
170
171
172
173
174

175
176
177
178
179
180
181
182








-
+








                 (debug:print-info 2 *default-log-port* "host " host " port " port " ping time: " ping " result " ping-res)
		 (case ping-res
		   ((running)
                    (debug:print-info 2 *default-log-port* "Setting conn = " conn " in hash table")
		    (hash-table-set! (tt-conns ttdat) dbfname conn) ;;; is this ok to save before validating that the connection is good?
		    conn)
		   ((starting)
		    (thread-sleep! 0.5)
		    (thread-sleep! 2)
                    (debug:print-info 0 *default-log-port* "server for " dbfname " is in starting state, retrying connect")
		    (tt:client-connect-to-server ttdat dbfname run-id testsuite))
		   (else
		    (let* ((curr-secs (current-seconds)))
		      ;; rm the (last server) would go here
		      (if (> (- curr-secs (tt-last-serv-start ttdat)) 10)
			  (begin
︙
291
292
293
294
295
296
297
298

299
300
301
302
303
304
305

291
292
293
294
295
296
297

298
299
300
301
302
303
304
305








-
+








				     ;; start server - addressed in client-connect-to-server
				     ;; delay        - addressed in client-connect-to-server
				     ;; try again
				     (thread-sleep! 0.25) ;; dunno, I think this needs to be here
				     (tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe))
				   ))))
		       (begin ;; no server file, delay and try again
			 (debug:print 0 *default-log-port* "INFO: connection to server "host":"port" broken for "dbfname", but do not see servinf file "servinf)
			 (debug:print 2 *default-log-port* "INFO: connection to server "host":"port" broken for "dbfname", but do not see servinf file "servinf)
			 (thread-sleep! 0.5)
			 (tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe))))
		 (begin ;; this case is where res is malformed. Probably should abort
		   (assert #f "FATAL: tt:handler received bad data "res)
		   ;; (debug:print 0 *default-log-port* "INFO: got corrupt data from server "host":"port", "res", for "dbfname", will try again.")
		   ;; (tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe)
		   )))))
︙

This page was generated in about 0.11s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00