Megatest

Check-in [1d8b9a3445]
Login
Overview
Comment:removed some debug messages
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70
Files: files | file ages | folders
SHA1: 1d8b9a344571d2982a6f29bae389c30481f5b244
User & Date: mmgraham on 2022-08-30 14:53:09
Other Links: branch diff | manifest | tags
Context
2022-08-30
15:44
Changed server timeout from 60 to 1200 seconds check-in: 36255e358b user: mmgraham tags: v1.70, v1.7006
14:53
removed some debug messages check-in: 1d8b9a3445 user: mmgraham tags: v1.70
2022-08-26
14:33
Changed methode used to update user /tmp from rsync to db:multi-db-sync check-in: dfcfe0c63c user: mmgraham tags: v1.70
Changes

Modified db.scm from [2d35b2b59d] to [8c707e9257].

660
661
662
663
664
665
666
667

668
669
670
671
672

673
674

675
676
677
678

679
680
681
682
683
684
685
660
661
662
663
664
665
666

667
668
669
670
671

672
673

674

675
676

677
678
679
680
681
682
683
684







-
+




-
+

-
+
-


-
+







     (lambda (file)
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.megatest/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   (debug:print-info 2 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "fulln)
			   (debug:print-info 2 *default-log-port* "Sync - I do not see file "fulln)
			   0)))
	      ;; (changed (> time1 time2))
	      (changed (> time1 time2))
              (changed ( < (- time2 time1) 6.0)) ;; dest db not updated within last 6 seconds
	      (do-cp (cond
		      ((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
		       (debug:print-info 0 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
		       (debug:print-info 2 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
		       #t)
		      (changed ;; (and changed
		       ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
		       #t)
		      ((and changed *time-to-exit*) ;; last sync
		       #t)
		      (else

Modified runs.scm from [42b2dde351] to [a334b12bd6].

321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335







-
+







;;
(define (runs:too-soon-delay key dseconds wseconds)
  (let* ((last-time (hash-table-ref/default *too-soon-delays* key #f)))
    (if (and last-time
	     (< (- (current-seconds) last-time) dseconds))
	(begin
	  (if (runs:lownoise (conc "too-soon-delay"key) 60)
	      (debug:print-info 0 *default-log-port* "Polling throttle for "key))
	      (debug:print-info 2 *default-log-port* "Polling throttle for "key))
	  (thread-sleep! wseconds)))
    (hash-table-set! *too-soon-delays* key (current-seconds))))

(define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)

  ;; Take advantage of a good place to exit if running the one-pass methodology
  (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679
1680
1681
1682
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683







+







	    (begin
	      (if (runs:lownoise "too-tight-loop" 5)
		  (debug:print-info 2 *default-log-port* "Excessively fast loop, delaying 1/2 second"))
	      (thread-sleep! 0.5)))
	(set! *last-loop-time-ms* (current-milliseconds))
     
	(runs:dat-regfull-set! runsdat regfull)


	(if (> (- (current-seconds) *last-test-launch*) 5)        ;; be pretty aggressive for five seconds after
	    (runs:too-soon-delay (conc "loop delay " hed) 1 0.6)    ;; starting a test then apply more delay
	    (runs:too-soon-delay (conc "loop delay " hed) 1 0.1)) 
	
	(if (> num-running 0)
            (set! last-time-some-running (current-seconds)))

Modified server.scm from [bb020a2020] to [3fa51300e8].

567
568
569
570
571
572
573


574
575
576
577
578
579
580
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582







+
+







  (lambda (toppath)
    (set! *db-last-access* (current-seconds)) ;; might not be needed.
    (if (equal? *toppath* toppath)
	#t
	#f)))

;; timeout is hms string: 1h 5m 3s, default is 1 minute
;; This is currently broken. Just use the number of hours with no unit.
;; Default is 60 seconds.
;;
(define (server:expiration-timeout)
  (let ((tmo (configf:lookup *configdat* "server" "timeout")))
    (if (and (string? tmo)
	     (common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
        (* 3600 (string->number tmo))
	60)))