146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
(let* ((config (tests:get-testconfig test-name #f all-tests-registry 'return-procs)))
(let ((instr (if config
(config-lookup config "requirements" "waiton")
(begin ;; No config means this is a non-existant test
(debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"")
(exit 1))))
(instr2 (if config
(config-lookup config "requirements" "waitor")
|
|
|
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
(let* ((config (tests:get-testconfig test-name #f all-tests-registry 'return-procs))) ;; assuming no problems with immediate evaluation, this could be simplified ('return-procs -> #t)
(let ((instr (if config
(config-lookup config "requirements" "waiton")
(begin ;; No config means this is a non-existant test
(debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"")
(exit 1))))
(instr2 (if config
(config-lookup config "requirements" "waitor")
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
(let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x))
(newpatt (conc waiton-test "/" (substring modpatt waiting-test-len (string-length modpatt)))))
;; (conc waiting-test "/," waiting-test "/" (substring modpatt waiton-test-len (string-length modpatt)))))
;; (print "in map, x=" x ", newpatt=" newpatt)
newpatt))
(filter (lambda (x)
(eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
patts))))
(string-intersperse (delete-duplicates (append patts (if (null? patts-waiton)
(list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
patts-waiton)))
",")))
|
|
|
|
|
>
>
>
>
>
>
>
>
|
>
>
>
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
(let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x))
(newpatt (conc waiton-test "/" (substring modpatt waiting-test-len (string-length modpatt)))))
;; (conc waiting-test "/," waiting-test "/" (substring modpatt waiton-test-len (string-length modpatt)))))
;; (print "in map, x=" x ", newpatt=" newpatt)
newpatt))
(filter (lambda (x)
(eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
patts)))
(extended-test-patt (append patts (if (null? patts-waiton)
(list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
patts-waiton)))
(extended-test-patt-with-toplevels
(fold (lambda (testpatt-item accum )
(let ((my-match (string-match "^([^%\\/]+)\\/.+$" testpatt-item)))
(cons testpatt-item
(if my-match
(cons
(conc (cadr my-match) "/")
accum)
accum))))
'()
extended-test-patt)))
(string-intersperse (delete-duplicates extended-test-patt-with-toplevels) ",")))
;; tests:glob-like-match
(define (tests:glob-like-match patt str)
(let ((like (substring-index "%" patt)))
(let* ((notpatt (equal? (substring-index "~" patt) 0))
|