Changes In Branch v1.64-dyn-waiton Through [a55a132e40] Excluding Merge-Ins
This is equivalent to a diff from 8b97104af8 to a55a132e40
|
2017-04-25
| ||
| 05:39 | Merged in latest from v1.65 check-in: d7dc89723c user: matt tags: v1.64-dyn-waiton | |
|
2017-04-19
| ||
| 12:06 | CHECK trumps WARN check-in: 2c45b8983c user: mrwellan tags: v1.64 | |
| 10:07 | Remaining changes to make dyn-waiton work well. check-in: a55a132e40 user: mrwellan tags: v1.64-dyn-waiton | |
|
2017-04-18
| ||
| 23:42 | Added waiton section support in megatest.config check-in: 8768044873 user: matt tags: v1.64-dyn-waiton | |
| 22:10 | Fixed (I think) dashboard issue with filtering. Bumped version to v1.6407 check-in: 8b97104af8 user: matt tags: v1.64 | |
| 14:12 | possible fix for dashboard filter update issue check-in: 7742f3ac5f user: mrwellan tags: v1.64, v1.6406 | |
Modified runs.scm from [5cb465e028] to [a4012b938d].
| ︙ | ︙ | |||
1227 1228 1229 1230 1231 1232 1233 |
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
(tconfig (tests:testqueue-get-testconfig test-record))
(jobgroup (config-lookup tconfig "test_meta" "jobgroup"))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
(if m (map string->symbol (string-split m)) '(normal))))
(itemmaps (tests:get-itemmaps tconfig)) ;; (configf:lookup tconfig "requirements" "itemmap"))
| | | 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 |
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
(tconfig (tests:testqueue-get-testconfig test-record))
(jobgroup (config-lookup tconfig "test_meta" "jobgroup"))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
(if m (map string->symbol (string-split m)) '(normal))))
(itemmaps (tests:get-itemmaps tconfig)) ;; (configf:lookup tconfig "requirements" "itemmap"))
(waitons (tests:just-get-waitons test-name test-records)) ;; (tests:testqueue-get-waitons test-record))
(priority (tests:testqueue-get-priority test-record))
(itemdat (tests:testqueue-get-itemdat test-record)) ;; itemdat can be a string, list or #f
(items (tests:testqueue-get-items test-record))
(item-path (item-list->path itemdat))
(tfullname (db:test-make-full-name test-name item-path))
(newtal (append tal (list hed)))
(regfull (>= (length reg) reglen))
|
| ︙ | ︙ | |||
1499 1500 1501 1502 1503 1504 1505 |
lst))
;; parent-test is there as a placeholder for when parent-tests can be run as a setup step
;;
(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
| | | 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 |
lst))
;; parent-test is there as a placeholder for when parent-tests can be run as a setup step
;;
(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:just-get-waitons test-name all-tests-registry)) ;; (tests:testqueue-get-waitons test-record))
(test-conf (tests:testqueue-get-testconfig test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(test-path (hash-table-ref all-tests-registry test-name)) ;; (conc *toppath* "/tests/" test-name)) ;; could use tests:get-testconfig here ...
(force (hash-table-ref/default flags "-force" #f))
(rerun (hash-table-ref/default flags "-rerun" #f))
(keepgoing (hash-table-ref/default flags "-keepgoing" #f))
(incomplete-timeout (string->number (or (configf:lookup *configdat* "setup" "incomplete-timeout") "x")))
|
| ︙ | ︙ |
Modified tests.scm from [30002a4340] to [2bc75b24cd].
| ︙ | ︙ | |||
140 141 142 143 144 145 146 |
'have-procedure)
((or (list? items)(list? itemstable)) ;; calc now
(debug:print-info 4 *default-log-port* "items and itemstable are lists, calc now\n"
" items: " items " itemstable: " itemstable)
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
| < > > | | > > > > > > > > > > > > > | | > | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 |
'have-procedure)
((or (list? items)(list? itemstable)) ;; calc now
(debug:print-info 4 *default-log-port* "items and itemstable are lists, calc now\n"
" items: " items " itemstable: " itemstable)
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
;; firm-require forces that the test be referred to in all-tests-registry
;;
(define (tests:get-waitons test-name all-tests-registry #!key (in-tconfig #f)(firm-require #t))
(let* ((config (or in-tconfig (tests:get-testconfig test-name #f all-tests-registry 'return-procs)))
(extras (configf:get-section *configdat* "waitons"))
(ewaits (if extras (alist-ref test-name extras string=?) #f))
(ewlst (if (and ewaits (not (null? ewaits)))
(string-split (car ewaits))
'()))
(ewadd (if (null? ewlst)
#t
(equal? (car ewlst) "+"))) ;; signal for add
(ewaitlst (if (null? ewlst)
ewlst
(if ewadd
(cdr ewlst)
ewlst))))
(let ((instr (if config
(config-lookup config "requirements" "waiton")
(if firm-require ;; begin ;; No config means this is a non-existant test
(debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"")
;; (exit 1)
)))
(instr2 (if config
(config-lookup config "requirements" "waitor")
"")))
(debug:print-info 8 *default-log-port* "waitons string is " instr ", waitors string is " instr2)
(let ((newwaitons
(string-split (cond
((procedure? instr) ;; here
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 | ((string? instr2) instr2) (else ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name) ""))))) (values ;; the waitons (filter (lambda (x) | > | > | > > | | > > > > > > > | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 |
((string? instr2) instr2)
(else
;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name)
"")))))
(values
;; the waitons
(filter (lambda (x)
(if (or (not firm-require)
(hash-table-ref/default all-tests-registry x #f))
#t
(begin
(debug:print-error 0 *default-log-port* "test " test-name " has unrecognised waiton testname " x)
#f)))
(if ewadd ;; area we adding or replacing the waitons
(append newwaitons ewaitlst)
ewaitlst))
(filter (lambda (x)
(if (or (not firm-require)
(hash-table-ref/default all-tests-registry x #f))
#t
(begin
(debug:print-error 0 *default-log-port* "test " test-name " has unrecognised waitor testname " x)
#f)))
newwaitors)
config)))))
;; seems like often we just want the waitons. Maybe time to get rid of the waitors concept?
;;
(define (tests:just-get-waitons test-name tests-registry #!key (in-tconfig #f)(firm-require #t))
(let-values (((waitons waitors tconfig)
(tests:get-waitons test-name tests-registry in-tconfig: in-tconfig firm-require: firm-require)))
waitons))
;; given waiting-test that is waiting on waiton-test extend test-patt appropriately
;;
;; genlib/testconfig sim/testconfig
;; genlib/sch sim/sch/cell1
;;
;; [requirements] [requirements]
|
| ︙ | ︙ | |||
1218 1219 1220 1221 1222 1223 1224 | (let ((tmp (any->number priority))) (if tmp tmp (begin (debug:print-error 0 *default-log-port* "bad priority value " priority ", using 0") 0))) 0))) (all-tests (hash-table-keys test-records)) (all-waited-on (let loop ((hed (car all-tests)) (tal (cdr all-tests)) (res '())) | | | | | | | 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 |
(let ((tmp (any->number priority)))
(if tmp tmp (begin (debug:print-error 0 *default-log-port* "bad priority value " priority ", using 0") 0)))
0)))
(all-tests (hash-table-keys test-records))
(all-waited-on (let loop ((hed (car all-tests))
(tal (cdr all-tests))
(res '()))
(let* (;; (trec (hash-table-ref test-records hed))
(waitons (tests:just-get-waitons hed test-records firm-require: #f))) ;; (or (tests:testqueue-get-waitons trec) '())))
(if (null? tal)
(append res waitons)
(loop (car tal)(cdr tal)(append res waitons))))))
(sort-fn1
(lambda (a b)
(let* ((a-record (hash-table-ref test-records a))
(b-record (hash-table-ref test-records b))
(a-waitons (tests:just-get-waitons a test-records firm-require: #f)) ;; (or (tests:testqueue-get-waitons a-record) '()))
(b-waitons (tests:just-get-waitons b test-records firm-require: #f)) ;; (or (tests:testqueue-get-waitons b-record) '()))
(a-config (tests:testqueue-get-testconfig a-record))
(b-config (tests:testqueue-get-testconfig b-record))
(a-raw-pri (config-lookup a-config "requirements" "priority"))
(b-raw-pri (config-lookup b-config "requirements" "priority"))
(a-priority (mungepriority a-raw-pri))
(b-priority (mungepriority b-raw-pri)))
(tests:testqueue-set-priority! a-record a-priority)
|
| ︙ | ︙ | |||
1288 1289 1290 1291 1292 1293 1294 |
(temp-port (open-output-file* fd)))
;; (format temp-port "This file is ~A.~%" temp-path)
(format temp-port "digraph tests {\n")
(format temp-port " size=4,8\n")
;; (format temp-port " splines=none\n")
(for-each
(lambda (testname)
| | | | 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 |
(temp-port (open-output-file* fd)))
;; (format temp-port "This file is ~A.~%" temp-path)
(format temp-port "digraph tests {\n")
(format temp-port " size=4,8\n")
;; (format temp-port " splines=none\n")
(for-each
(lambda (testname)
(let* (;; (testrec (hash-table-ref test-records testname))
(waitons (tests:just-get-waitons testname test-records firm-require: #f))) ;; (or (tests:testqueue-get-waitons testrec) '())))
(for-each
(lambda (waiton)
(format temp-port (conc " " waiton " -> " testname " [splines=ortho]\n")))
waitons)))
all-testnames)
(format temp-port "}\n")
(close-output-port temp-port)
|
| ︙ | ︙ | |||
1320 1321 1322 1323 1324 1325 1326 |
'()
(let loop ((hed (car all-testnames))
(tal (cdr all-testnames))
(res (list "digraph tests {"
(conc " size=\"" (or sizex 11) "," (or sizey 11) "\";")
" ratio=0.95;"
)))
| | | | 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 |
'()
(let loop ((hed (car all-testnames))
(tal (cdr all-testnames))
(res (list "digraph tests {"
(conc " size=\"" (or sizex 11) "," (or sizey 11) "\";")
" ratio=0.95;"
)))
(let* (;; (testrec (hash-table-ref test-records hed))
(waitons (tests:just-get-waitons hed test-records firm-require: #f)) ;; (or (tests:testqueue-get-waitons testrec) '()))
(newres (append res
(if (null? waitons)
(list (conc " \"" hed "\" [shape=box];"))
(map (lambda (waiton)
(conc " \"" waiton "\" -> \"" hed "\" [shape=box];"))
waitons)
))))
|
| ︙ | ︙ | |||
1378 1379 1380 1381 1382 1383 1384 |
(let ((runnables '()))
(for-each
(lambda (testkeyname)
(let* ((test-record (hash-table-ref testrecordshash testkeyname))
(test-name (tests:testqueue-get-testname test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(item-path (tests:testqueue-get-item_path test-record))
| | | 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 |
(let ((runnables '()))
(for-each
(lambda (testkeyname)
(let* ((test-record (hash-table-ref testrecordshash testkeyname))
(test-name (tests:testqueue-get-testname test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(item-path (tests:testqueue-get-item_path test-record))
(waitons (tests:just-get-waitons test-name testrecordshash)) ;; (tests:testqueue-get-waitons test-record))
(keep-test #t)
(test-id (rmt:get-test-id run-id test-name item-path))
(tdat (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id *runremote* test-id)))
(if tdat
(begin
;; Look at the test state and status
(if (or (and (member (db:test-get-status tdat)
|
| ︙ | ︙ | |||
1425 1426 1427 1428 1429 1430 1431 |
(define (tests:get-full-data test-names test-records required-tests all-tests-registry)
(if (not (null? test-names))
(let loop ((hed (car test-names))
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(debug:print-info 4 *default-log-port* "hed=" hed " at top of loop")
;; don't know item-path at this time, let the testconfig get the top level testconfig
(let* ((config (tests:get-testconfig hed #f all-tests-registry 'return-procs))
| > > > | | | | | | | | | | | | | | | | 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 |
(define (tests:get-full-data test-names test-records required-tests all-tests-registry)
(if (not (null? test-names))
(let loop ((hed (car test-names))
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(debug:print-info 4 *default-log-port* "hed=" hed " at top of loop")
;; don't know item-path at this time, let the testconfig get the top level testconfig
(let* ((config (tests:get-testconfig hed #f all-tests-registry 'return-procs))
(waitons (let-values (((waitons waitors tconfigdat)
(tests:get-waitons hed all-tests-registry)))
waitons)))
;; (let ((instr (if config
;; (config-lookup config "requirements" "waiton")
;; (begin ;; No config means this is a non-existant test
;; (debug:print-error 0 *default-log-port* "non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.")
;; ""))))
;; (debug:print-info 8 *default-log-port* "waitons string is " instr)
;; (string-split (cond
;; ((procedure? instr)
;; (let ((res (instr)))
;; (debug:print-info 8 *default-log-port* "waiton procedure results in string " res " for test " hed)
;; res))
;; ((string? instr) instr)
;; (else
;; ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " hed)
;; ""))))))
(if (not config) ;; this is a non-existant test called in a waiton.
(if (null? tal)
test-records
(loop (car tal)(cdr tal)))
(begin
(debug:print-info 8 *default-log-port* "waitons: " waitons)
;; check for hed in waitons => this would be circular, remove it and issue an
|
| ︙ | ︙ |