Megatest

Diff
Login

Differences From Artifact [4e52ed5cac]:

To Artifact [76afa47739]:


502
503
504
505
506
507
508
509













510
511
512
513
514
515
516
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528







-
+
+
+
+
+
+
+
+
+
+
+
+
+







	    (set! server-going #t)
	    (debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version))) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
	  (if (and no-sync-db
		   (common:low-noise-print 10 "sync-all")) ;; cheesy way to reduce frequency of running sync :)
              (begin
		(if (common:low-noise-print 120 "sync-all-print")
                    (debug:print 0 *default-log-port* "keep-running calling db:all-db-sync at " (time->string (seconds->local-time) "%H:%M:%S")))
		(db:all-db-sync *dbstruct-dbs*))))
		(db:all-db-sync *dbstruct-dbs*)
		(if (common:low-noise-print 1800 "sync-back") ;; every half hour do a reverse sync
		    (let* ((lockfile (conc *toppath*"/.megatest/syncback.lock"))
			   (locked   (common:simple-file-lock lockfile)))
		      (if locked
			  (begin
			    (db:multi-db-sync
			     *dbstruct-dbs*
			     'dejunk
			     'adj-testids
			     'old2new)
			    (common:simple-file-release-lock lockfile)))))
		)))
      
      ;; when things go wrong we don't want to be doing the various queries too often
      ;; so we strive to run this stuff only every four seconds or so.
      (let* ((sync-time (- (current-milliseconds) start-time))
	    (rem-time  (quotient (- 4000 sync-time) 1000)))
	(if (and (<= rem-time 4)
		 (>  rem-time 0))