Overview
Comment: | Added push/pop dir to *toppath* in runconfigs for consistent loading of runconfigs |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | development |
Files: | files | file ages | folders |
SHA1: |
d72d1dc4b867725939f49e316c78c26d |
User & Date: | mrwellan on 2013-04-10 18:11:30 |
Other Links: | branch diff | manifest | tags |
Context
2013-04-10
| ||
22:45 | Added launch speed test and fdk compatibility test check-in: 6964f022fb user: matt tags: development | |
18:11 | Added push/pop dir to *toppath* in runconfigs for consistent loading of runconfigs check-in: d72d1dc4b8 user: mrwellan tags: development | |
16:43 | Re-did config file path handling, removed directory-push/directory-pop for syle more consistent with old behavior check-in: 7906872d60 user: mrwellan tags: development | |
Changes
Modified common.scm from [fc2e76989a] to [02a5ef0a9a].
︙ | ︙ | |||
144 145 146 147 148 149 150 151 152 153 154 155 156 157 | (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; System stuff ;;====================================================================== (define (get-df path) (let* ((df-results (cmd-run->list (conc "df " path))) (space-rx (regexp "([0-9]+)\\s+([0-9]+)%")) (freespc #f)) ;; (write df-results) (for-each (lambda (l) | > > > > > > | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; System stuff ;;====================================================================== ;; return a nice clean pathname made absolute (define (nice-path dir) (normalize-pathname (if (absolute-pathname? dir) dir (conc (current-directory) "/" dir)))) (define (get-df path) (let* ((df-results (cmd-run->list (conc "df " path))) (space-rx (regexp "([0-9]+)\\s+([0-9]+)%")) (freespc #f)) ;; (write df-results) (for-each (lambda (l) |
︙ | ︙ |
Modified configf.scm from [ee796a94b9] to [34fdb76110].
︙ | ︙ | |||
146 147 148 149 150 151 152 | (close-input-port inp) (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht res) (regex-case inl (configf:comment-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f)) (configf:blank-l-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f)) | | | | > | < < | > | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | (close-input-port inp) (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht res) (regex-case inl (configf:comment-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f)) (configf:blank-l-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f)) (configf:include-rx ( x include-file ) (let* ((curr-conf-dir (pathname-directory path)) (full-conf (if (absolute-pathname? include-file) include-file (nice-path (conc curr-conf-dir "/" include-file))))) (if (file-exists? full-conf) (begin ;; (push-directory conf-dir) (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections) ;; (pop-directory) (loop (configf:read-line inp res allow-system) curr-section-name #f #f)) (begin (debug:print 2 "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 " " full-conf) (loop (configf:read-line inp res allow-system) curr-section-name #f #f))))) (configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f)) |
︙ | ︙ |
Modified runconfig.scm from [09fb252607] to [d27b298e19].
1 2 3 4 5 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") |
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) (define (set-run-config-vars db run-id keys keyvals) (let ((runconfigf (conc *toppath* "/runconfigs.config")) (targ (or (args:get-arg "-target") (args:get-arg "-reqtarg") (db:get-target db run-id)))) (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id #t keys keyvals environ-patt: (conc "(default" (if targ (conc "|" targ ")") ")"))) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) | > > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) (define (set-run-config-vars db run-id keys keyvals) (push-directory *toppath*) (let ((runconfigf (conc *toppath* "/runconfigs.config")) (targ (or (args:get-arg "-target") (args:get-arg "-reqtarg") (db:get-target db run-id)))) (pop-directory) (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id #t keys keyvals environ-patt: (conc "(default" (if targ (conc "|" targ ")") ")"))) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) |