502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
|
#f)))))
(define (test:get-testconfig test-name system-allowed)
(let* ((test-path (conc *toppath* "/tests/" test-name))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf))))
(if testexists
(read-config test-configf #f system-allowed)
#f)))
;; sort tests by priority and waiton
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-names)
(let ((testdetails (make-hash-table))
(mungepriority (lambda (priority)
|
|
>
>
|
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
#f)))))
(define (test:get-testconfig test-name system-allowed)
(let* ((test-path (conc *toppath* "/tests/" test-name))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf))))
(if testexists
(read-config test-configf #f system-allowed environ-patt: (if system-allowed
"pre-launch-env-vars"
#f))
#f)))
;; sort tests by priority and waiton
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-names)
(let ((testdetails (make-hash-table))
(mungepriority (lambda (priority)
|
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
|
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(set! keys (db-get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config"))
(runconfig (read-config runconfigf #f #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
(begin
(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(sqlite3:finalize! db)
(exit 1))))
(if (args:get-arg "-target")
|
|
|
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
|
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(set! keys (db-get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; evaluate all
(runconfig (read-config runconfigf #f #f environ-patt: ".*")))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
(begin
(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(sqlite3:finalize! db)
(exit 1))))
(if (args:get-arg "-target")
|