171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
+
|
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
(let* ((keys (keys:config-get-fields *configdat*))
(keyvals (keys:target->keyval keys target))
(run-id (rmt:register-run keyvals runname "new" "n/a" user)) ;; test-name)))
;; (deferred '()) ;; delay running these since they have a waiton clause
(runconfigf (conc *toppath* "/runconfigs.config"))
(test-records (make-hash-table))
(test-deps (make-hash-table))
;; need to process runconfigs before generating these lists
(all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
(all-test-names #f) ;; (hash-table-keys all-tests-registry))
(test-names #f) ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
(required-tests #f) ;; Put fully qualified test/testpath names in this list to be done
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
(tdbdat (tasks:open-db))
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
-
+
|
(if (not test-patts) ;; first time in - adjust testpatt
(set! test-patts (common:args-get-testpatt runconf)))
;; Now generate all the tests lists
(set! all-tests-registry (tests:get-all)) ;; hash of testname => path-to-test
(set! all-test-names (hash-table-keys all-tests-registry))
(set! test-names (tests:filter-test-names all-test-names test-patts))
;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.
;; NEW STRATEGY HERE:
;; 1. fill required tests with test-patts
;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt
;; 3. repeat until all deps propagated
|
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
(if (and waiton (not (member waiton test-names)))
(let* ((waiton-record (hash-table-ref/default test-records waiton #f))
(waiton-tconfig (if waiton-record (vector-ref waiton-record 1) #f))
(waiton-itemized (and waiton-tconfig
(or (hash-table-ref/default waiton-tconfig "items" #f)
(hash-table-ref/default waiton-tconfig "itemstable" #f))))
(itemmaps (tests:get-itemmaps config)) ;; (configf:lookup config "requirements" "itemmap"))
(mode (tests:get-mode config))
(new-test-patts (tests:extend-test-patts test-patts hed waiton itemmaps)))
(debug:print-info 0 "Test " waiton " has " (if waiton-record "a" "no") " waiton-record and" (if waiton-itemized " " " no ") "items")
;;(debug:print-info 0 "BB> Test is "hed" test-patts is "test-patts)
;;(debug:print-info 0 "BB> waiton is " waiton " mode is " mode" and new-test-patts is "new-test-patts)
;; need to account for test-patt here, if I am test "a", selected with a test-patt of "hed/b%"
;; and we are waiting on "waiton" we need to add "waiton/,waiton/b%" to test-patt
;; is this satisfied by merely appending "/" to the waiton name added to the list?
;;
;; This approach causes all of the items in an upstream test to be run
;; if we have this waiton already processed once we can analzye it for extending
;; tests to be run, since we can't properly process waitons unless they have been
;; initially added we add them again to be processed on second round AND add the hed
;; back in to also be processed on second round
;;
;;(debug:print-info 0 "BB> remaining tests: "tal)
(let ((hed-depended-on-by-remaining-test
;; BB>> don't set testpatt if hed is waited on by another test in testnames
(foldr
(lambda (remaining-test previous-result)
(let ((dependencies-on-remaining-test
(hash-table-ref/default test-deps remaining-test '()))
(mode (tests:get-mode config)))
;;(debug:print-info 0 "BB> remaining-test="remaining-test" dependencies-on-remaining-test: "dependencies-on-remaining-test)
(or previous-result
(if (or
(not (equal? "itemwait" mode))
(member hed dependencies-on-remaining-test))
#t
#f))))
#f
tal)))
;;(debug:print-info 0 "BB> hed="hed" hed-depended-on-by-remaining-test="hed-depended-on-by-remaining-test)
(if waiton-tconfig
(begin
(set! test-names (cons waiton test-names)) ;; need to process this one, only add once the waiton tconfig read
(if waiton-itemized
(begin
(debug:print-info 0 "New test patts: " new-test-patts ", prev test patts: " test-patts)
(set! required-tests (cons (conc waiton "/") required-tests))
(set! test-patts new-test-patts))
(begin
(debug:print-info 0 "Adding non-itemized test " waiton " to required-tests")
(set! required-tests (cons waiton required-tests))
(set! test-patts new-test-patts))))
(begin
(debug:print-info 0 "No testconfig info yet for " waiton ", setting up to re-process it")
(set! tal (append (cons waiton tal)(list hed))))) ;; (cons (conc waiton "/") required-tests))
(if (not (null? required-tests))
(debug:print-info 1 "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 "test-records=" (hash-table->alist test-records))
(let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
(if (> (length (hash-table-keys test-records)) 0)
(let* ((keep-going #t)
|