31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all area-dat)
(let* ((test-search-path (tests:get-tests-search-path (megatest:area-configdat area-dat))))
(tests:get-valid-tests (make-hash-table) test-search-path)))
(define (tests:get-tests-search-path cfgdat area-dat)
(let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
(append paths (list (conc (megatest:area-path area-dat) "/tests")))))
(define (tests:get-valid-tests test-registry tests-paths)
|
|
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all area-dat)
(let* ((test-search-path (tests:get-tests-search-path (megatest:area-configdat area-dat) area-dat)))
(tests:get-valid-tests (make-hash-table) test-search-path)))
(define (tests:get-tests-search-path cfgdat area-dat)
(let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
(append paths (list (conc (megatest:area-path area-dat) "/tests")))))
(define (tests:get-valid-tests test-registry tests-paths)
|
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
|
runnables))
;;======================================================================
;; refactoring this block into tests:get-full-data from line 263 of runs.scm
;;======================================================================
;; hed is the test name
;; test-records is a hash of test-name => test record
(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 "hed=" hed " at top of loop")
(let* ((config (tests:get-testconfig hed all-tests-registry 'return-procs))
(waitons (let ((instr (if config
(config-lookup config "requirements" "waiton")
(begin ;; No config means this is a non-existant test
(debug:print 0 "ERROR: non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.")
""))))
(debug:print-info 8 "waitons string is " instr)
(string-split (cond
|
|
|
|
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
|
runnables))
;;======================================================================
;; refactoring this block into tests:get-full-data from line 263 of runs.scm
;;======================================================================
;; hed is the test name
;; test-records is a hash of test-name => test record
(define (tests:get-full-data test-names test-records required-tests all-tests-registry area-dat)
(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 "hed=" hed " at top of loop")
(let* ((config (tests:get-testconfig hed all-tests-registry 'return-procs area-dat))
(waitons (let ((instr (if config
(config-lookup config "requirements" "waiton")
(begin ;; No config means this is a non-existant test
(debug:print 0 "ERROR: non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.")
""))))
(debug:print-info 8 "waitons string is " instr)
(string-split (cond
|