Megatest

Changes On Branch v1.65-cleanup-try-3
Login

Changes In Branch v1.65-cleanup-try-3 Excluding Merge-Ins

This is equivalent to a diff from 58bd90c5bc to 293027ea36

2020-10-04
22:21
Trial 3. Backout server throttle code. Closed-Leaf check-in: 293027ea36 user: matt tags: v1.65-cleanup-try-3
2020-08-26
23:04
Tweaked server gate - still not right :( ==/FAIL/orion/== check-in: 7e26fb2f0c user: mrwellan tags: v1.65-cleanup
22:56
fixed obscure bug when db is slightly malformed due to ^C. Tweak server gating, it is still not quite right... check-in: 58bd90c5bc user: mrwellan tags: v1.65-cleanup
21:14
Added instrumentation for server start throttle. ==/3.18/0.6/PASS/1201/orion/== check-in: 56b3986bbb user: mrwellan tags: v1.65-cleanup

Modified db.scm from [2f649dc1fb] to [8677e5cc9c].

457
458
459
460
461
462
463

464


465
466
467
468
469
470
471
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472
473







+
-
+
+







	  exn
	(begin
	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
	  (thread-sleep! 3)
	  (sqlite3:interrupt! db)
	  (db:safely-close-sqlite3-db db stmtcache try-num: (- try-num 1)))
	(if (sqlite3:database? db)
	    (let* ((stmts (if (hash-table? stmt-cache)
	    (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
                              (hash-table-ref/default stmt-cache db #f)
                               #f)))
	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
	      (sqlite3:finalize! db)
	      #t)
	    #f))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)

Modified server.scm from [0ee248d5ed] to [6a075dedb1].

322
323
324
325
326
327
328
329
330
331



332
333
334
335
336




337
338
339


340
341
342
343
344
345
346
322
323
324
325
326
327
328



329
330
331


332


333
334
335
336
337
338

339
340
341
342
343
344
345
346
347







-
-
-
+
+
+
-
-

-
-
+
+
+
+


-
+
+








;; wait for server=start-last to be three seconds old
;;
(define (server:wait-for-server-start-last-flag areapath)
  (let* ((start-flag (conc areapath "/logs/server-start-last")))
    (if (file-exists? start-flag)
	(let* ((fmodtime (file-modification-time start-flag))
	       (reftime  (+ 2 (random 3)))
	       (delta    (- (current-seconds) fmodtime))
	       (all-go   (> delta reftime)))
	       (reftime  (+ 3 (random 5)))
	       (delta    (- (current-seconds) fmodtime)))
	  (if (> delta reftime) ;; good enough
	  (if all-go
	      #t ;; (system (conc "touch " start-flag)) ;; lazy but safe
	      (begin
		(debug:print-info 0 *default-log-port* "Gating server start, last start: "
				  fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go)
		(debug:print-info 0 *default-log-port* "Ready to start server, last start: "
				  fmodtime ", delta: " delta ", reftime: " reftime)
		(system (conc "touch " start-flag))) ;; lazy but safe
	      (begin
		(thread-sleep! 5)
		(server:wait-for-server-start-last-flag areapath))))
	#;(system (conc "touch " start-flag)))))
	(system (conc "touch " start-flag)))))
	      

;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
;;
(define (server:kind-run areapath)
  ;; look for $MT_RUN_AREA_HOME/logs/server-start-last
  ;; and wait for it to be at least 3 seconds old