Megatest

Diff
Login

Differences From Artifact [d882a4a65c]:

To Artifact [cc2812bc1b]:


26
27
28
29
30
31
32


33
34
35
36
37
38

39

40
41
42
43
44
45
46
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50







+
+






+

+







(declare (uses lock-queue))
(declare (uses db))
(declare (uses tdb))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses server))
(declare (uses margsmod))
(import margsmod)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
(require-library stml)

(declare (uses commonmod))
(declare (uses debugprint))
(import commonmod)
(import debugprint)

(declare (uses dbmod))
(import dbmod)

(declare (uses configfmod))
(import configfmod)

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
164
165
166
167
168
169
170
















171
172
173
174
175
176
177







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
(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 (let ((section (if cfgdat
				  (configf:get-section cfgdat "tests-paths")
				  #f)))
		 (if section
		     (map cadr section)
		     '()))))
    (filter (lambda (d)
	      (if (directory-exists? d)
		  d
		  (begin
		    ;; (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
		    ;;	(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
		    #f)))
	    (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 (common:file-exists? hed)
	    (for-each (lambda (test-path)