257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
+
|
(if (not (null? remtests))
(loop (car remtests)(cdr remtests)))))))
(if (not (null? required-tests))
(debug:print 1 "INFO: Adding " required-tests " to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(runs:run-tests-queue db run-id runname test-records keyvallst flags)
(if *rpc:listener* (server:keep-running db))
(debug:print 4 "INFO: All done by here")))
(define (runs:run-tests-queue db run-id runname test-records keyvallst flags)
;; At this point the list of parent tests is expanded
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", keyvallst: " keyvallst)
(let ((sorted-test-names (tests:sort-by-priority-and-waiton test-records))
|
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
|
-
-
+
+
+
|
(debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
(exit 1))))
;; we get here on "drop through" - loop for next test in queue
(if (null? tal)
(begin
;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
(debug:print 1 "INFO: All tests launched, exiting")
(exit 0))
(debug:print 1 "INFO: All tests launched")
;; (exit 0)
)
(loop (car tal)(cdr tal))))))
;; parent-test is there as a placeholder for when parent-tests can be run as a setup step
(define (run:test db run-id runname keyvallst test-record flags parent-test)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:testqueue-get-waitons test-record))
|
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
|
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
-
+
|
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (args:get-arg "-server")
(server:start db (args:get-arg "-server"))
(if (not (or (args:get-arg "-runall")
(args:get-arg "-runtests")))
(set! th1 (server:client-setup db))))
(server:client-setup db)))
(set! keys (rdb:get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #f environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|