Index: commonmod.scm ================================================================== --- commonmod.scm +++ commonmod.scm @@ -2022,15 +2022,15 @@ (let* ((target (common:args-get-target)) ;; (tagexpr (args:get-arg "-tagexpr")) ;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f)) (testpatt-key (or (args:get-arg "-modepatt") (args:get-arg "--modepatt") "TESTPATT")) (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%")) - (rtestpatt (if rconf (runconfigs-get rconf target testpatt-key) #f))) + (rtestpatt (if rconf (runconfigs-get rconf testpatt-key target) #f))) (cond ((or (args:get-arg "--modepatt") (args:get-arg "-modepatt")) ;; modepatt is a forced setting, when set it MUST refer to an existing PATT in the runconfig (if rconf - (let* ((patts-from-mode-patt (runconfigs-get rconf target testpatt-key))) + (let* ((patts-from-mode-patt (runconfigs-get rconf testpatt-key target))) (debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key " " patts-from-mode-patt) patts-from-mode-patt) (begin (debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for " testpatt-key) ;; " " patts-from-mode-patt) #f))) ;; We do NOT fall back to "%" Index: configfmod.scm ================================================================== --- configfmod.scm +++ configfmod.scm @@ -33,10 +33,11 @@ configf:alist->config configf:assoc-safe-add configf:config->alist configf:find-and-read-config configf:get-section + configf:get-sections configf:lookup configf:lookup-number configf:map-all-hier-alist configf:read-alist configf:read-config @@ -131,10 +132,13 @@ (cadr res) #f)) )) #f)) +(define (configf:get-sections cfgdat) + (filter string? (hash-table-keys cfgdat))) + (define (configf:assoc-safe-add alist key val #!key (metadata #f)) (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) (append newalist (list (if metadata (list key val metadata) (list key val)))))) @@ -378,14 +382,12 @@ (open-input-file path) path)) ;; we can be handed a port (res (let ((ht-in (if (not ht) (make-hash-table) ht))) - (if (not (hash-table-exists? ht-in 'metadata)) - (begin - (hash-table-set! ht-in 'metadata (make-hash-table)) - (hash-table-set! (hash-table-ref ht-in 'metadata) 'toppath path))) + (if (not (configf:lookup ht-in "" "toppath")) + (configf:set-section-var ht-in "" "toppath" path)) ht-in)) (metapath (if (or (debug:debug-mode 9) keep-filenames) path #f)) (process-wildcards (lambda (res curr-section-name) @@ -1026,12 +1028,11 @@ ((system) `(noeval-needed ,(conc (configf:system ht cmd)))) ;; ((shell sh) `(noeval-needed ,(conc (string-translate (shell quotedcmd) "\n" " ")))) ((shell sh) `(noeval-needed ,(conc (string-translate (shell cmd) "\n" " ")))) ((realpath rp)`(noeval-needed ,(conc (common:nice-path quotedcmd)))) ((getenv gv) `(noeval-needed ,(conc (get-environment-variable cmd)))) - ;; TODO - replace *toppath* and var reliance with getting path where *this* config file was found - ((mtrah) `(noeval-needed ,(hash-table-ref (hash-table-ref ht 'metadata) 'toppath))) ;; (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\")))) + ((mtrah) `(noeval-needed ,(configf:lookup ht "" "toppath"))) ((get g) (match (string-split cmd) ((sect var) `(noeval-needed ,(configf:lookup ht sect var))) (else @@ -1140,12 +1141,12 @@ res))) ;;====================================================================== ;; Lookup a value in runconfigs based on -reqtarg or -target ;; -(define (runconfigs-get config var) - (let ((targ (mytarget) #;(common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET")))) +(define (runconfigs-get config var #!optional (target #f)) + (let ((targ (or target (mytarget)))) ;; (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET")))) (if targ (or (configf:lookup config targ var) (configf:lookup config "default" var)) (configf:lookup config "default" var)))) @@ -1192,11 +1193,11 @@ (res (begin (with-output-to-file fname ;; first write out the file (lambda () (pp dat))) - + ;; I don't like this. It makes write-alist opaque and complicated. -mrw- (if (file-exists? fname) ;; now verify it is readable (if (configf:read-alist fname) #t ;; data is good. (begin (handle-exceptions Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -1067,11 +1067,11 @@ ;; (dboard:tabdat-all-test-names-set! tabdat (collapse-rows tabdat - (sort (hash-table-keys all-test-names) string>?))) ;; FIXME: Sorting needs to happen here + (sort (filter string? (hash-table-keys all-test-names)) string>?))) ;; FIXME: Sorting needs to happen here ;; Trim the names list to fit the matrix of buttons ;; (dboard:tabdat-all-test-names-set! tabdat @@ -2864,11 +2864,11 @@ ((external) ;; was tabs (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num))) (set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames)) (set! tab-num (+ tab-num 1)) (set! result (append result (list tab-content))))))))) - (sort (hash-table-keys views-cfgdat) + (sort (configf:get-sections views-cfgdat) ;; (hash-table-keys views-cfgdat) (lambda (a b) (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999)) (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999))) (> order-a order-b))))) result)) Index: runsmod.scm ================================================================== --- runsmod.scm +++ runsmod.scm @@ -2140,15 +2140,15 @@ (bup-mutex (make-mutex)) (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode". (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs)) - (dbfile (conc *toppath* "/megatest.db")) + (dbfile (conc *toppath* "/.db/main.db")) (readonly-mode (not (file-writable? dbfile)))) (when (and readonly-mode (member action write-access-actions)) - (debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .") + (debug:print-error 0 *default-log-port* ".db/main.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .") (exit 1))) (debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status) (if (> 2 (length state-status)) (begin