Megatest

Check-in [db1d22eadb]
Login
Overview
Comment:Merged trim sleeps
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: db1d22eadb8a586d7fc580a3d82029bdf7443d3c
User & Date: mrwellan on 2019-04-01 08:32:14
Other Links: branch diff | manifest | tags
Context
2019-04-01
12:45
ensure test status does not change to preq_fail if it already completed check-in: ab579cdb7a user: bjbarcla tags: v1.65
08:33
Merged v1.65 to trunk check-in: 22fac8b130 user: mrwellan tags: trunk
08:32
Merged trim sleeps check-in: db1d22eadb user: mrwellan tags: v1.65
2019-03-29
17:59
Trim couple sleeps that seem unnecessary Closed-Leaf check-in: 1550ea7ddf user: mrwellan tags: v1.65-trim-sleeps
13:17
merged changes to reduce load of brute force syner check-in: f61052be3c user: bjbarcla tags: v1.65, v1.6528
Changes

Modified server.scm from [a266765465] to [868645b72c].

326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340







-
+







				(else 600))
			      (random 5)))   ;; add a small random number just in case a lot of jobs hit the work hosts simultaneously
	     (lock-file    (conc areapath "/logs/server-start.lock")))
	(if	(> (- (current-seconds) when-run) run-delay)
		(begin
		  (common:simple-file-lock-and-wait lock-file expire-time: 15)
		  (server:run areapath)
		  (thread-sleep! 5) ;; don't release the lock for at least a few seconds
		  (thread-sleep! 2) ;; don't release the lock for at least a few seconds
		  (common:simple-file-release-lock lock-file)))
	(hash-table-set! *server-kind-run* areapath (list (+ call-num 1)(current-seconds))))))

(define (server:start-and-wait areapath #!key (timeout 60))
  (let ((give-up-time (+ (current-seconds) timeout)))
    (let loop ((server-url (server:check-if-running areapath))
	       (try-num    0))
592
593
594
595
596
597
598
599

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

599
600
601
602
603
604
605
606







-
+







              (BB> "End do-a-sync with fork-to-background="fork-to-background" persist-until-sync="persist-until-sync" and result="finalres)
              finalres)
            ) ;; end lambda
          ))
    do-a-sync))

(define (server:writable-watchdog dbstruct)
  (thread-sleep! 10) ;; delay for startup
  (thread-sleep! 1) ;; delay for startup
  (let* ((do-a-sync  (server:get-bruteforce-syncer dbstruct))
         (final-sync (server:get-bruteforce-syncer dbstruct fork-to-background: #t persist-until-sync: #t)))
    (when (and (not (args:get-arg "-sync-to-megatest.db")) ;; conditions under which we do not run the sync
	       (args:get-arg "-server"))
      
      (let loop ()
	(do-a-sync)