Megatest

Check-in [cac03d47f8]
Login
Overview
Comment:Filter out tests paths and warn if not a directory
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: cac03d47f86241ee10252e6cc4d9e15c845637f0
User & Date: matt on 2015-06-13 23:56:33
Other Links: branch diff | manifest | tags
Context
2015-06-14
05:35
Fixed itemwait and itemmatch check-in: 21475c886a user: matt tags: v1.60
2015-06-13
23:56
Filter out tests paths and warn if not a directory check-in: cac03d47f8 user: matt tags: v1.60
23:47
Got release rollup test fully correct check-in: dfc505d26e user: matt tags: v1.60
Changes

Modified tests.scm from [e0052ea812] to [776832d893].

39
40
41
42
43
44
45






46

47
48
49
50
51
52
53
39
40
41
42
43
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
59







+
+
+
+
+
+
-
+







;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat)
  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
    (filter (lambda (d)
	      (if (directory-exists? d)
		  d
		  (begin
		    (debug:print 0 "WARNING: problem with directory " d ", dropping it from tests path")
		    #f)))
    (append paths (list (conc *toppath* "/tests")))))
	    (append paths (list (conc *toppath* "/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)