Megatest

Check-in [85f3eeb353]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Reordered logic in tt:client-connect-to-server, changed sleep after starting server from 3 to 6 seconds.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-revolution
Files: files | file ages | folders
SHA1: 85f3eeb353bbd025d208402eac0e62023b10e7eb
User & Date: mmgraham on 2024-01-22 11:15:53
Other Links: branch diff | manifest | tags
Context
2024-01-23
11:24
Cleaned up couple duplicated functions. check-in: c616c43313 user: mrwellan tags: v1.80-revolution
2024-01-22
11:15
Reordered logic in tt:client-connect-to-server, changed sleep after starting server from 3 to 6 seconds. check-in: 85f3eeb353 user: mmgraham tags: v1.80-revolution
2024-01-19
22:10
guarded against empty run name and no target selected in Run Control. check-in: 3947694200 user: mmgraham tags: v1.80-revolution
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified tcp-transportmod.scm from [074453490b] to [312708d26e].

︙
175
176
177
178
179
180
181


182

183
184
185

186

187
188
189
190
191
192
193

175
176
177
178
179
180
181
182
183

184
185
186
187
188

189
190
191
192
193
194
195
196








+
+
-
+



+
-
+








				   testsuite ;; (dbfile:testsuite-name)
				   (common:find-local-megatest)
				   run-id)))))
    (if conn
	(begin 
          (debug:print-info 2 *default-log-port* "already connected to a server")
           conn) ;; we are already connected to the server

	;; no conn
	(let* ((sdats (tt:get-server-info-sorted ttdat dbfname))
        (let* ((sdats (tt:get-server-info-sorted ttdat dbfname))
	       (sdat  (if (null? sdats)
			  #f
			  (car sdats))))
	   (debug:print-info 2 *default-log-port* "found sdat " sdat)
	  (match sdat
           (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
	     (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
             (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
	     (let* ((host-port (conc host":"port))
		    (conn (make-tt-conn
			   host: host
			   port: port
︙
209
210
211
212
213
214
215
216


217
218
219
220
221
222
223
224

225
226
227
228

229
230
231

232

233
234
235
236

237
238
239

240
241
242

243
244
245
246
247
248
249

212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227

228



229
230
231
232

233
234
235
236
237
238

239
240
241

242
243
244

245
246
247
248
249
250
251
252








-
+
+







-
+
-
-
-

+


-
+

+



-
+


-
+


-
+








		    conn)
		   ((starting)
		    (thread-sleep! 0.5)
                    (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 server-start-proc))
		   (else
		    (let* ((curr-secs (current-seconds)))
		      (if (not ping-res) ;; the server is actually dead, remove the .servinfo file
		      ;; rm the (last server) would go here
		      (if (> (- curr-secs (tt-last-serv-start ttdat)) 10)
			  (begin
			    (debug:print-info 0 *default-log-port* "Unreachable server at "
					      host":"port" with servinfo file "servinffile", removing it")
			    (if (file-exists? servinffile)
				(handle-exceptions
				 exn
				 #f
				 (delete-file servinffile)))))
				 (delete-file servinffile)))
		      ;; rm the (last server) would go here
		      (if (> (- curr-secs (tt-last-serv-start ttdat)) 10)
			  (begin
			    (tt-last-serv-start-set! ttdat curr-secs)
                            (debug:print-info 0 *default-log-port* "Starting a new server on " (get-host-name))
			    (server-start-proc))) ;; start server if 10 sec since last attempt
		      (thread-sleep! 1)
                      (debug:print-info 0 *default-log-port* "server ping result was "ping-res" neither running nor starting. Retrying connect")
                      (debug:print-info 0 *default-log-port* "Retrying connect")
		      (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

	    (else ;; no good server found, if haven't started server in > 5 secs, start another
	     (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 3) ;; BUG - grow this number really do not want to swamp the machine with servers
		 (begin
		   (debug:print-info 0 *default-log-port* "Starting server for "dbfname)
		   (debug:print-info 0 *default-log-port* "Starting server for "dbfname " on " (get-host-name))
		   (server-start-proc)
		   (tt-last-serv-start-set! ttdat (current-seconds))
                   (thread-sleep! 3)
                   (thread-sleep! 6)
                   ))
	     (thread-sleep! 1)
             (debug:print-info 0 *default-log-port* "Connect to server for " dbfname)
             (debug:print-info 0 *default-log-port* "Connect to server from " (get-host-name) " for " dbfname)
	     (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

;; returns ( result . ping_time )
(define (tt:timed-ping host port server-id)
  (let* ((start-time (current-milliseconds))
	 (result     (tt:ping host port server-id)))
    (cons result (- (current-milliseconds) start-time))))
︙
588
589
590
591
592
593
594

595
596
597
598
599
600
601

591
592
593
594
595
596
597
598
599
600
601
602
603
604
605








+








		      (thread-sleep! 0.25)
		      (loop (+ count 1)))
		    (begin
		      (debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set! Exiting.")
		      (exit)))))
	  
	  ;; create a servinfo file start keep-running
          (debug:print 0 *default-log-port* "Creating servinfo file for " dbfname)
	  (tt:create-server-registration-file ttdat dbfname)
	  (procinf-status-set! *procinf* "running")
	  (tt-state-set! ttdat 'running)
	  (dbfile:with-no-sync-db
	   nosyncdbpath
	   (lambda (nsdb)
	     (dbfile:insert-or-update-process nsdb *procinf*)))
︙
902
903
904
905
906
907
908

909
910
911
912
913
914
915


916



917
918
919
920
921
922
923

906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
930
931
932








+







+
+
-
+
+
+








;; 	 (setup-listener uconn (+ port 1)))
;;        #f)
;;    (connect-listener uconn port)))

(define (setup-listener-portlogger uconn)
  (let ((port (portlogger:open-run-close portlogger:find-port)))
    (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)
    (debug:print 2 *default-log-port* "setup-listener-portlogger got port " port)
    (handle-exceptions
	exn
      (if (< port 65535)
	  (begin
	    (portlogger:open-run-close portlogger:set-failed port)
	    (thread-sleep! 0.25)
	    (setup-listener-portlogger uconn))
          (begin
            (debug:print 0 *default-log-port* "setup-listener-portlogger: could not get a port")
	  #f)
	    #f
          )
      )
      (connect-listener uconn port))))

(define (connect-listener uconn port)
  ;; (tcp-listener-socket LISTENER)(socket-name so)
  ;; sockaddr-address, sockaddr-port, sockaddr->string
  (let* ((tlsn (tcp-listen port 10000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
	 (addr  (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
︙

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