282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
(if (string? w)(string-split w)'()))))
(if (not testexists)
(begin
(print "ERROR: Can't find config file " test-configf)
(exit 2))
;; put top vars into convenient variables and open the db
(let* (;; db is always at *toppath*/db/megatest.db
(items (hash-table-ref/default test-conf "items" #f))
(allitems (item-assoc->item-list items))
(runconfigf (conc *toppath* "/runconfigs.config")))
;; (print "items: ")(pp allitems)
(if (args:get-arg "-m")
(db:set-comment-for-run db run-id (args:get-arg "-m")))
(let loop ((itemdat (car allitems))
(tal (cdr allitems)))
;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
(let* ((item-path (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
(new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
|
|
>
>
|
>
>
|
|
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
(if (string? w)(string-split w)'()))))
(if (not testexists)
(begin
(print "ERROR: Can't find config file " test-configf)
(exit 2))
;; put top vars into convenient variables and open the db
(let* (;; db is always at *toppath*/db/megatest.db
(items (hash-table-ref/default test-conf "items" '()))
(itemstable (hash-table-ref/default test-conf "itemstable" '()))
(allitems (if (or (not (null? items))(not (null? itemstable)))
(append (item-assoc->item-list items)
(item-table->item-list itemstable))
'(()))) ;; a list with one null list is a test with no items
(runconfigf (conc *toppath* "/runconfigs.config")))
(print "items: ")(pp allitems)
(if (args:get-arg "-m")
(db:set-comment-for-run db run-id (args:get-arg "-m")))
(let loop ((itemdat (car allitems))
(tal (cdr allitems)))
;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
(let* ((item-path (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
(new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
|