Megatest

Diff
Login

Differences From Artifact [25307e2263]:

To Artifact [547f7c34a1]:


31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
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))))
  (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
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)
(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))
	(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