This is equivalent to a diff from
600ba0778d
to f5a00d621d
Modified dashboard.scm
from [e5b27b795a]
to [89bc431aeb].
| ︙ | | |
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
+
+
|
;; please-update: #t
;; update-mutex: (make-mutex)
;; updaters: (make-hash-table)
;; updating: #f
;; hide-not-hide-tabs: #f
;; target: ""
;; ))
(set! *journal-stats-enable* #f)
;;======================================================================
;; buttons color using image
;;======================================================================
(define *images* (make-hash-table))
|
| ︙ | | |
Added docs/csirc version [ab27eade5c].
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(cond-expand
(chicken-4
;; chicken 4 stuff here
(use readline)
(current-input-port (make-readline-port))
(install-history-file #f "/.csi.history")
)
(chicken-5
(import (chicken load))
(import (chicken format))
(import (chicken process-context))
(import (chicken process signal))
(load-verbose #f)
(let ()
(unless (get-environment-variable "INSIDE_EMACS")
(import breadline)
(import breadline-scheme-completion)
(history-file (format "~a/.csi_history" (get-environment-variable "HOME")))
(stifle-history! 10000)
(completer-word-break-characters-set! "\"\'`;|(")
(completer-set! scheme-completer)
(basic-quote-characters-set! "\"|")
(variable-bind! "blink-matching-paren" "on")
(paren-blink-timeout-set! 200000)
(let ((handler (signal-handler signal/int)))
(set-signal-handler! signal/int
(lambda (s)
(cleanup-after-signal!)
(reset-after-signal!)
(handler s))))
(on-exit reset-terminal!)
(current-input-port (make-readline-port))))
))
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Modified rmt.scm
from [519878889b]
to [0cdd3c737a].
| ︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
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
121
122
123
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
|
;; NB// area-dat replaced by ttdat
;;
(define (rmt:send-receive cmd run-id params #!key (attemptnum 1)(ttdat #f))
(assert (or (not run-id) (number? run-id)) "FATAL: run-id is required to be a number or #f")
(assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")
(let* ((areapath *toppath*) ;; TODO - resolve from dbstruct to be compatible with multiple areas
(readonly-mode (rmtmod:calc-ro-mode ttdat *toppath*))
(testsuite (common:get-testsuite-name)))
(testsuite (common:get-testsuite-name))
(dbfname (conc (dbfile:run-id->dbnum run-id)".db"))
(dbdir (conc areapath "/.mtdb")))
(if (and (not *journal-stats*)
(file-exists? dbdir))
(tt:start-stats dbdir)) ;; fixme - find the right call to get the db directory
;; check the load on dbfname and add some delay using a droop curve of sorts
(if *journal-stats*
(let* ((load (tt:get-journal-stats dbfname)))
(if (> load 0.1) ;; start activating delay at 10% journal load time
(let ((dely (* 50 (* load load)))) ;; 100% journal time=50sec delay
(debug:print 0 *default-log-port* "Journal load "load" on "dbfname" delaying queries "dely"s.")
(thread-sleep! dely)))))
(case (rmt:transport-mode)
((tcp)
(let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
(attemptnum (+ 1 attemptnum))
(mtexe (common:find-local-megatest))
(dbfname (conc (dbfile:run-id->dbnum run-id)".db"))
|
| ︙ | | |
Modified runs.scm
from [0cd899f860]
to [adfae1025a].
| ︙ | | |
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
|
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(registry-mutex (runs:dat-registry-mutex runsdat))
(flags (runs:dat-flags runsdat))
(keyvals (runs:dat-keyvals runsdat))
(run-info (runs:dat-run-info runsdat))
(all-tests-registry (runs:dat-all-tests-registry runsdat))
(run-limits-info (runs:dat-can-run-more-tests runsdat))
;; (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
(have-resources (car run-limits-info))
(have-resources (and (if *journal-stats*
(let* ((dbfname (conc
(dbfile:run-id->dbnum run-id)
".db"))
(load (tt:get-journal-stats dbfname)))
(if (> load 0.1) ;; dbs too busy to start more tests
(begin
(debug:print-info 0 *default-log-port* "Gating launch due to db load "load" based on journal file observations for "dbfname)
#f)
#t))
(begin
(debug:print-info 0 *default-log-port* "Journal gating not started for "run-id)
#t)) ;; if journal monitoring not started do not gate
(car run-limits-info)))
(num-running (list-ref run-limits-info 1))
(num-running-in-jobgroup(list-ref run-limits-info 2))
(max-concurrent-jobs (list-ref run-limits-info 3))
(job-group-limit (list-ref run-limits-info 4))
;; (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))
;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
(fails (if (list? prereqs-not-met) ;; TODO: rename fails to failed-prereqs
|
| ︙ | | |
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
|
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
|
-
+
|
(if (eq? nth-try 'removed) ;; removed is removed - drop it NOW
(if (null? tal)
#f ;; yes, really
(list (car tal)(cdr tal) reg reruns))
(begin
(if (runs:lownoise (conc "FAILED prerequisites or other issue" hed) 60)
(debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state >" nth-try "< will be overridden and we'll retry."))
(let* ((test-id (rmt:get-test-id run-id testname item-path))
(let* ((test-id (rmt:get-test-id run-id hed item-path))
(test-info (rmt:get-testinfo-state-status run-id test-id)) ;; we need *current* info
(status (db:test-status test-info)))
(if (equal? status "KEEP_TRYING")
(mt:test-set-state-status-by-testname-unless-completed run-id test-name item-path "COMPLETED" "PREQ_FAIL" #f)
(mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f)))
(hash-table-set! test-registry hed 'removed) ;; was 0
(if (not (and (null? reg) (null? tal)))
|
| ︙ | | |
Modified tcp-transportmod.scm
from [c9c309998d]
to [d0258d10eb].
| ︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
|
extras
hostinfo
ports
posix
files
data-structures
directory-utils
tcp
))
(chicken-5
(import chicken.base
chicken.condition
chicken.file
chicken.pathname
|
| ︙ | | |
1126
1127
1128
1129
1130
1131
1132
1133
1134
|
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
|
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(sort (get-all-ips) ip-pref-less?))
(define (get-all-ips)
(map address-info-host
(filter (lambda (x)
(equal? (address-info-type x) "tcp"))
(address-infos (get-host-name)))))
;;======================================================================
;; Other Utils
;;======================================================================
)
|
Added utils/setcicd version [bb9f0e8cef].
|
1
2
3
4
5
6
7
8
9
10
|
+
+
+
+
+
+
+
+
+
+
|
#!/bin/bash
branch=$(fossil branch current)
wikiname=${branch}_cicd
echo "ready to merge" > $wikiname
if fossil wiki export $wikiname;then
fossil wiki commit $wikiname $wikiname
else
fossil wiki create $wikiname $wikiname
fi
|
| | | | | | | | |