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 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 | (import commonmod debugprint rmtmod (prefix mtargs args:)) (include "common_records.scm") | < < < < < < < | 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 (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 |
(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 '()))
;; 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))
| > > > > > > > | 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 |
(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)
| | | 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! 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 | ;; 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 | | | 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 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) ))))) |
| ︙ | ︙ |