Overview
Context
Changes
Modified configf.scm
from [3ed4257dc9]
to [ab4120ebb1].
| ︙ | | |
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
-
+
+
+
+
+
+
+
+
|
inl)
(else
(configf:process-line inl ht allow-processing)))))
(if (and (string? res)
(not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "no")))
(string-substitute "\\s+$" "" res)
res))))))
|
| ︙ | | |
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
-
+
-
-
-
-
-
-
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
|
(debug:print-info 1 "read-config - file not found " path " current path: " (current-directory))
;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?
#f) ;; (if (not ht)(make-hash-table) ht))
(let ((inp (open-input-file path))
(res (if (not ht)(make-hash-table) ht))
(metapath (if (or (debug:debug-mode 9)
keep-filenames)
path #f))
path #f)))
(calc-allow-system (lambda (allow-system section sections)
(if sections
(and (or (equal? "default" section)
(member section sections))
allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings
allow-system))))
(configf:comment-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))
(configf:comment-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(configf:settings ( x setting val ) (begin
(hash-table-set! settings setting val)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) 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 (if curr-conf-dir
curr-conf-dir
".")
"/" include-file)))))
(if (file-exists? full-conf)
(begin
;; (push-directory conf-dir)
(debug:print 9 "Including: " full-conf)
(read-config full-conf res (calc-allow-system allow-system curr-section sections) environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
(read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
;; (pop-directory)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(begin
(debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")")
(debug:print 2 " " full-conf)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)))))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)))))
(configf:section-rx ( x section-name ) (begin
;; call post-section-procs
(for-each
(lambda (dat)
(let ((patt (car dat))
(proc (cdr dat)))
(if (string-match patt curr-section-name)
(proc curr-section-name section-name res path))))
post-section-procs)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
;; 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)))
(configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section sections)
(configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section-name sections)
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((start-time (current-seconds))
(cmdres (process:cmd-run->list cmd))
(delta (- (current-seconds) start-time))
(status (cadr cmdres))
(res (car cmdres)))
|
| ︙ | | |
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
|
-
+
-
-
+
+
-
+
-
+
-
-
+
+
-
+
|
(debug:print-info 9 "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
(case (calc-allow-system allow-system curr-section sections)
(case (calc-allow-system allow-system curr-section-name sections)
((return-procs) val-proc)
((return-string) cmd)
(else (val-proc)))
metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)))
(configf:key-val-pr ( x key unk1 val unk2 ) (let* ((alist (hash-table-ref/default res curr-section-name '()))
(envar (and environ-patt (string-search (regexp environ-patt) curr-section-name)))
(realval (if envar
(config:eval-string-in-environment val)
val)))
(debug:print-info 6 "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar (safe-setenv key realval))
(debug:print 10 " setting: [" curr-section-name "] " key " = " val)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key realval metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name key #f)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name key #f)))
(configf:key-no-val ( x key val) (let* ((alist (hash-table-ref/default res curr-section-name '())))
(debug:print 10 " setting: [" curr-section-name "] " key " = #t")
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key #t metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name key #f)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) 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 metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
(else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))))))))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))))))
;; pathenvvar will set the named var to the path of the config
(define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname toppath: given-toppath))
(toppath (car configinfo))
(configfile (cadr configinfo))
|
| ︙ | | |
Modified launch.scm
from [46e3920792]
to [a14c9a2485].
| ︙ | | |
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
|
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
|
-
+
-
-
+
|
(linktree (common:get-linktree))
(mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config
(rundir (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
(mtcachef (and rundir (conc rundir "/" ".megatest.cfg-" megatest-version "-" megatest-fossil-hash)))
(rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash)))
(cancreate (and rundir (file-exists? rundir)(file-write-access? rundir))))
;; (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef)
;; (if (not *toppath*)(set! *toppath* toppath)) ;; this probably is not needed?
(set! *toppath* toppath) ;; This is needed when we are running as a test using CMDINFO as a datasource
(cond
;; data was read and cached and available in *configstatus*, toppath has already been set
((eq? *configstatus* 'fulldata)
*toppath*)
;; if mtcachef exists just read it, however we need to assume toppath is available in $MT_RUN_AREA_HOME
((and mtcachef (file-exists? mtcachef) (get-environment-variable "MT_RUN_AREA_HOME"))
(set! *configdat* (configf:read-alist mtcachef))
(set! *runconfigdat* (configf:read-alist rccachef))
(set! *configinfo* (list *configdat* (get-environment-variable "MT_RUN_AREA_HOME")))
(set! *configstatus* 'fulldata)
(set! *toppath* (get-environment-variable "MT_RUN_AREA_HOME"))
*toppath*)
;; we have all the info needed to fully process runconfigs and megatest.config
(mtcachef
(let* ((toppath (get-environment-variable "MT_RUN_AREA_HOME")) ;; rely on MT_RUN_AREA_HOME if we are in a test environment
(sections (list "default" target)) ;; for runconfigs
|
| ︙ | | |