Megatest

Check-in [1de8b8b2f8]
Login
Overview
Comment:Runner throttleing based on shared time.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65 | v1.6559
Files: files | file ages | folders
SHA1: 1de8b8b2f8d4cb3d4dfa8b2b92428122c26cd8ad
User & Date: mrwellan on 2020-08-12 12:29:13
Other Links: branch diff | manifest | tags
Context
2020-08-15
18:22
Converted a call from imperative to functional and added statement caching. check-in: 2bc12a6a8b user: matt tags: v1.65
2020-08-12
12:29
Runner throttleing based on shared time. check-in: 1de8b8b2f8 user: mrwellan tags: v1.65, v1.6559
00:40
Deficit based runner control check-in: 161115127c user: matt tags: v1.65
Changes

Modified megatest-version.scm from [89d4156eaa] to [18b07b6776].

16
17
18
19
20
21
22
23

16
17
18
19
20
21
22

23







-
+
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6558)
(define megatest-version 1.6559)

Modified runs.scm from [4924c7f209] to [c2ee7717e6].

59
60
61
62
63
64
65
66
67
68



69
70
71
72

73
74
75
76
77
78
79
80
81
82
83
84
85



86
87
88
89
90




91
92
93



94
95
96
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
59
60
61
62
63
64
65



66
67
68
69
70


71
72












73
74
75





76
77
78
79



80
81
82
83
84
85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109







-
-
-
+
+
+


-
-
+

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










-
+








-
+







(defstruct runs:testdat
  hed tal reg reruns  test-record
  test-name item-path jobgroup
  waitons testmode  newtal itemmaps prereqs-not-met)
  
;; Fourth try, do accounting through time
;;
(define (runs:parallel-runners-mgmt-4 rdat)
  (let ((time-to-check 2.8) ;; 28
	(time-to-wait  3.0)
(define (runs:parallel-runners-mgmt rdat)
  (let ((time-to-check 10) ;; 28
	(time-to-wait  12)
	(now-time      (current-seconds)))
    (if (> (- now-time (runs:dat-last-fuel-check rdat)) time-to-check) ;; time to check
	(let* ((mgmt-mode          (runs:dat-runners-mgmt-mode rdat)) ;;
	       (fuel-used          (rmt:get-var "runners-fuel")))
	(let* ((fuel-used          (or (rmt:get-var "runners-fuel") now-time)))
	  ;; initialize and sanitize values if needed
	  (cond
	   ((not fuel-used) ;; first in, initialize to 1
	    (debug:print-info 0 *default-log-port* " adjusting num-runners up to 1, currently it is not defined")
	    (rmt:set-var "fuel-used" now-time)
	    (set! fuel-used now-time)
	    (runs:dat-last-fuel-check-set! rdat now-time))
	   (else ;; add fuel used since last time
	    (rmt:add-var "fuel-used" (- now-time (runs:dat-last-fuel-check rdat)))))
	  
	   (if (> fuel-used now-time) ;; are we over-drawn? If so, kill time, do not add time to fuel used
	       (begin ;; gonna rest
		 (debug:print-info 0 *default-log-port* "Too much fuel used, taking a break. fuel-used="
	  (if (> fuel-used (+ now-time 1)) ;; are we over-drawn? If so, kill time, do not add time to fuel used
	      (begin ;; gonna rest
		(debug:print-info 0 *default-log-port* "Runner load high, taking a break.")
				   fuel-used ", now-time=" now-time)
		 (thread-sleep! time-to-wait)
		 (runs:dat-last-fuel-check-set! rdat (current-seconds)) ;; work done from here (i.e. seconds of "fuel") will be added to fuel-used 
		 )
	       (begin ;; no fuel deficit, back to work
		(thread-sleep! time-to-wait)
		(runs:dat-last-fuel-check-set! rdat (current-seconds)) ;; work done from here (i.e. seconds of "fuel") will be added to fuel-used 
		)
	      (begin ;; no fuel deficit, back to work
		 (debug:print-info 0 *default-log-port* "No deficit, keep running"))
	       )))))
	  
		(rmt:set-var "runners-fuel" (+ now-time time-to-check))
		))))))

;; To test parallel-runners management start a repl:
;;  megatest -repl
;; then run:
;;  (runs:test-parallel-runners 60)
;;
(define (runs:test-parallel-runners duration #!optional (proc #f))
  (let* ((rdat   (make-runs:dat))
	 (rtime  0)
	 (startt (current-seconds))
	 (endt   (+ startt duration)))
    ((or proc runs:parallel-runners-mgmt-4) rdat)
    ((or proc runs:parallel-runners-mgmt) rdat)
    (let loop ()
      (let* ((wstart (current-seconds)))
	(if (< wstart endt)
	    (let* ((work-time (random 10)))
	      #;(debug:print-info 0 *default-log-port* "working for " work-time
				" seconds. Total work: " rtime ", elapsed time: " (- wstart startt))
	      (thread-sleep! work-time)
	      (set! rtime (+ rtime work-time))
	      ((or proc runs:parallel-runners-mgmt-4) rdat)
	      ((or proc runs:parallel-runners-mgmt) rdat)
	      (loop)))))
    (let* ((done-time (current-seconds)))
      (debug:print-info 0 *default-log-port* "DONE: rtime=" rtime ", elapsed time=" (- done-time startt)
			", ratio=" (/ rtime (- done-time startt))))))

;; ;; Third try, use a running average
;; ;;