14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses mtargs))
(declare (uses rmtmod))
(declare (uses dbfile))
|
<
<
>
>
>
>
>
>
>
>
>
>
>
<
<
<
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(declare (unit runs))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses processmod))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses rmtmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses megatestmod))
(declare (uses mtmod))
(declare (uses tasksmod))
(declare (uses servermod))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format sxml-serializer
sxml-modifications matchable)
|
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(import commonmod
processmod
configfmod
debugprint
rmtmod
dbfile
(prefix mtargs args:))
;; use this struct to facilitate refactoring
;;
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
|
>
>
|
>
>
>
>
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
(import commonmod
processmod
configfmod
debugprint
rmtmod
dbfile
dbmod
megatestmod
(prefix mtargs args:)
mtmod
tasksmod
servermod
)
;; use this struct to facilitate refactoring
;;
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
|
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
|
;;
(if (runs:dat-load-mgmt-function runsdat)
((runs:dat-load-mgmt-function runsdat))
(runs:dat-load-mgmt-function-set!
runsdat
(lambda ()
;; jobtools maxload is useful for where the full Megatest run is done on one machine
(if (and (not (common:on-homehost?))
maxload) ;; only gate if maxload is specified, NOTE: maxload is normalized, i.e. load=1 means all cpus fully utilized
(common:wait-for-normalized-load maxload "Waiting for load to drop before starting more tests" #f))
;; jobtools maxhomehostload is intended to prevent overloading on the homehost which can cause database corruption issues
(if maxhomehostload
(common:wait-for-homehost-load maxhomehostload
(conc "Waiting for homehost load to drop below normalized value of " maxhomehostload))))))
|
|
|
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
|
;;
(if (runs:dat-load-mgmt-function runsdat)
((runs:dat-load-mgmt-function runsdat))
(runs:dat-load-mgmt-function-set!
runsdat
(lambda ()
;; jobtools maxload is useful for where the full Megatest run is done on one machine
(if (and (not (rmt:on-homehost?))
maxload) ;; only gate if maxload is specified, NOTE: maxload is normalized, i.e. load=1 means all cpus fully utilized
(common:wait-for-normalized-load maxload "Waiting for load to drop before starting more tests" #f))
;; jobtools maxhomehostload is intended to prevent overloading on the homehost which can cause database corruption issues
(if maxhomehostload
(common:wait-for-homehost-load maxhomehostload
(conc "Waiting for homehost load to drop below normalized value of " maxhomehostload))))))
|