136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
((null? res) #f)
((string? (cdr res)) (cdr res)) ;; it is a pair
((string? (cadr res))(cadr res)) ;; it is a list
(else cadr res))))))
(define (tests:get-global-waitons rconfig)
(let* ((global-waitons (runconfigs-get config "!GLOBAL_WAITONS")))
(if (string? global-waitons)
(string-split global-waitons)
'())))
;; return items given config
;;
(define (tests:get-items tconfig)
|
|
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
((null? res) #f)
((string? (cdr res)) (cdr res)) ;; it is a pair
((string? (cadr res))(cadr res)) ;; it is a list
(else cadr res))))))
(define (tests:get-global-waitons rconfig)
(let* ((global-waitons (runconfigs-get rconfig "!GLOBAL_WAITONS")))
(if (string? global-waitons)
(string-split global-waitons)
'())))
;; return items given config
;;
(define (tests:get-items tconfig)
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
(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
(configf:lookup config "requirements" "waitor")
"")))
(debug:print-info 8 *default-log-port* "waitons string is " instr ", waitors string is " instr2)
(let ((newwaitons-tmp
(string-split (cond
((procedure? instr) ;; here
(let ((res (instr)))
(debug:print-info 8 *default-log-port* "waiton procedure results in string " res " for test " test-name)
res))
((string? instr) instr)
(else
;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name)
""))))
(newwaitors
(string-split (cond
((procedure? instr2)
(let ((res (instr2)))
(debug:print-info 8 *default-log-port* "waitor procedure results in string " res " for test " test-name)
res))
((string? instr2) instr2)
(else
;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name)
""))))
(newwaitons (if global-waitons
(append newwaitons-tmp global-waitons)
newwaitons-tmp)))
(values
;; the waitons
(filter (lambda (x)
(if (hash-table-ref/default all-tests-registry x #f)
#t
(begin
|
|
|
>
>
>
|
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
(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
(configf:lookup config "requirements" "waitor")
"")))
(debug:print-info 8 *default-log-port* "waitons string is " instr ", waitors string is " instr2)
(let* ((newwaitons-tmp
(string-split (cond
((procedure? instr) ;; here
(let ((res (instr)))
(debug:print-info 8 *default-log-port* "waiton procedure results in string " res " for test " test-name)
res))
((string? instr) instr)
(else
;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name)
""))))
(newwaitors
(string-split (cond
((procedure? instr2)
(let ((res (instr2)))
(debug:print-info 8 *default-log-port* "waitor procedure results in string " res " for test " test-name)
res))
((string? instr2) instr2)
(else
;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name)
""))))
(newwaitons (if (and (list? global-waitons)
(not (null? global-waitons)))
(begin
(debug:print 0 *default-log-port* "Adding global waitons " global-waitons)
(append newwaitons-tmp global-waitons))
newwaitons-tmp)))
(values
;; the waitons
(filter (lambda (x)
(if (hash-table-ref/default all-tests-registry x #f)
#t
(begin
|