Overview
| Comment: | Added experimental support for #{...} |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
e6bdd79d6f7c43e9f12cfb9e705a8c3e |
| User & Date: | mrwellan on 2012-03-27 18:03:03 |
| Other Links: | manifest | tags |
Context
|
2012-03-28
| ||
| 15:46 | Changed the #{ ... } mechanism to be highly specific and improved options check-in: 50de060113 user: mrwellan tags: trunk | |
|
2012-03-27
| ||
| 18:03 | Added experimental support for #{...} check-in: e6bdd79d6f user: mrwellan tags: trunk | |
|
2012-03-26
| ||
| 21:05 | Added ability to override max load in nbfind, default is 50% of avail. cpus check-in: a684b5f022 user: matt tags: trunk | |
Changes
Added .fossil-settings/ignore-glob version [9a10308043].
> | 1 | utils/build/* |
Modified configf.scm from [9adef42084] to [e647f94ff3].
| ︙ | ︙ | |||
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
(define configf:blank-l-rx (regexp "^\\s*$"))
(define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
(define configf:key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
(define (read-config path ht allow-system #!key (environ-patt #f))
(debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt)
(if (not (file-exists? path))
(if (not ht)(make-hash-table) ht)
(let ((inp (open-input-file path))
(res (if (not ht)(make-hash-table) ht)))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 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 174 175 176 177 178 179 |
(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
(define configf:blank-l-rx (regexp "^\\s*$"))
(define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
(define configf:key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
;; read a line and process any #{ ... } constructs
(define configf:var-expand-regex (regexp "^(.*)#\\{([^\\}\\{]*)\\}(.*)"))
(define (configf:process-line l)
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let ((prestr (cadr matchdat))
(cmd (caddr matchdat))
(poststr (cadddr matchdat))
(result #f))
(with-input-from-string (conc "(" cmd ")")
(lambda ()
(set! result (eval (read)))))
(loop (conc prestr result poststr)))
res))
res)))
(define (shell cmd)
(let* ((output (cmd-run->list cmd))
(res (car output))
(status (cadr output)))
(if (equal? status 0)
(string-intersperse
res
"\n")
(begin
(with-output-to-port (current-error-port)
(print "ERROR: " cmd " returned bad exit code " status))
""))))
(define-inline (configf:read-line p)
(configf:process-line (read-line p)))
;; read a config file, returns hash table of alists
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
(define (read-config path ht allow-system #!key (environ-patt #f))
(debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt)
(if (not (file-exists? path))
(if (not ht)(make-hash-table) ht)
(let ((inp (open-input-file path))
(res (if (not ht)(make-hash-table) ht)))
(let loop ((inl (configf:read-line inp)) ;; (read-line inp))
(curr-section-name "default")
(var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere
(lead #f))
(if (eof-object? inl)
(begin
(close-input-port inp)
res)
(regex-case
inl
(configf:comment-rx _ (loop (configf:read-line inp) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (configf:read-line inp) curr-section-name #f #f))
(configf:include-rx ( x include-file ) (begin
(read-config include-file res allow-system environ-patt: environ-patt)
(loop (configf:read-line inp) curr-section-name #f #f)))
(configf:section-rx ( x section-name ) (loop (configf:read-line inp) section-name #f #f))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status)
(exit 1)))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
(case allow-system
((return-procs) val-proc)
((return-string) cmd)
(else (val-proc)))))
(loop (configf:read-line inp) curr-section-name #f #f))
(loop (configf:read-line inp) curr-section-name #f #f)))
(configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '()))
(envar (and environ-patt (string-match (regexp environ-patt) curr-section-name)))
(realval (if envar
(config:eval-string-in-environment val)
val)))
(if envar
(begin
(debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval)
(setenv key realval)))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key realval))
(loop (configf:read-line inp) curr-section-name key #f)))
;; if a continued line
(configf:cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '())))
(if var-flag ;; if set to a string then we have a continued var
(let ((newval (conc
(config-lookup res curr-section-name var-flag) "\n"
;; trim lead from the incoming whsp to support some indenting.
(if lead
(string-substitute (regexp lead) "" whsp)
"")
val)))
;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist var-flag newval))
(loop (configf:read-line inp) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp) curr-section-name #f #f))))
(else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp) curr-section-name #f #f))))))))
(define (find-and-read-config fname #!key (environ-patt #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname))
(toppath (car configinfo))
(configfile (cadr configinfo)))
(if toppath (change-directory toppath))
|
| ︙ | ︙ |
Modified tests/megatest.config from [58f01c3e22] to [ca77d7087d].
| ︙ | ︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 | # These are set before all tests, override them # in the testconfig [pre-launch-env-overrides] section [env-override] SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs TESTVAR [system realpath .] DEADVAR [system ls] VARWITHDOLLAR $HOME/.zshrc # XTERM [system xterm] # RUNDEAD [system exit 56] ## disks are: ## name host:/path/to/area ## -or- | > | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
# These are set before all tests, override them
# in the testconfig [pre-launch-env-overrides] section
[env-override]
SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs
TESTVAR [system realpath .]
DEADVAR [system ls]
VARWITHDOLLAR $HOME/.zshrc
WACKYVAR #{system "ls"}
# XTERM [system xterm]
# RUNDEAD [system exit 56]
## disks are:
## name host:/path/to/area
## -or-
|
| ︙ | ︙ |