Megatest

Diff
Login

Differences From Artifact [f04a81c96a]:

To Artifact [25307e2263]:


30
31
32
33
34
35
36
37
38


39
40
41

42
43

44
45
46
47
48
49
50
30
31
32
33
34
35
36


37
38
39
40

41
42

43
44
45
46
47
48
49
50







-
-
+
+


-
+

-
+







(include "common_records.scm")
(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)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
(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)
(define (tests:get-tests-search-path cfgdat area-dat)
  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
    (append paths (list (conc *toppath* "/tests")))))
    (append paths (list (conc (megatest:area-path area-dat) "/tests")))))

(define (tests:get-valid-tests test-registry tests-paths)
  (if (null? tests-paths) 
      test-registry
      (let loop ((hed (car tests-paths))
		 (tal (cdr tests-paths)))
	(if (file-exists? hed)
582
583
584
585
586
587
588
589
590


591
592
593
594
595
596
597
582
583
584
585
586
587
588


589
590
591
592
593
594
595
596
597







-
-
+
+







;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))

(define (tests:get-testconfig test-name test-registry system-allowed)
  (let* ((test-path    (hash-table-ref/default test-registry test-name (conc *toppath* "/tests/" test-name)))
(define (tests:get-testconfig test-name test-registry system-allowed area-dat)
  (let* ((test-path    (hash-table-ref/default test-registry test-name (conc (megatest:area-path area-dat) "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (tcfg         (if testexists
			   (read-config test-configf #f system-allowed environ-patt: (if system-allowed
											 "pre-launch-env-vars"
											 #f))
			   #f)))