Overview
| Comment: | resolved target variables not being seen by item elaboration system calls issue |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64 | v1.6435 |
| Files: | files | file ages | folders |
| SHA1: |
a67b8a13eef96061f2e8256b93197d73 |
| User & Date: | bjbarcla on 2017-10-23 14:52:23 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-10-25
| ||
| 12:05 | addressed chained-waiton issues as well as rollup to deleted issue check-in: 907dd389a6 user: bjbarcla tags: v1.64 | |
|
2017-10-24
| ||
| 10:19 | Merged v1.64 into runarun check-in: ea0bf5d237 user: mrwellan tags: v1.65-runarun | |
|
2017-10-23
| ||
| 17:54 | wip check-in: d0f652f47e user: bjbarcla tags: v1.64-chainedwaiton | |
| 14:52 | resolved target variables not being seen by item elaboration system calls issue check-in: a67b8a13ee user: bjbarcla tags: v1.64, v1.6435 | |
| 14:51 | updated env-delta calculator to honor allow-system; bumped version to 1.6435 Leaf check-in: d6d1370c83 user: bjbarcla tags: v1.64-runvar | |
|
2017-10-18
| ||
| 17:06 | added exception handler around trigger handler that was stack dumping for asicqa check-in: 50fc48a28b user: bjbarcla tags: v1.64, v1.6434 | |
Changes
Modified common.scm from [cb654d8da6] to [ec7c4778b7].
| ︙ | ︙ | |||
2311 2312 2313 2314 2315 2316 2317 |
(if (common:file-exists? mthome-cfgfile)
(read-config mthome-cfgfile view-cfgdat #t))
;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
(if (common:file-exists? home-cfgfile)
(read-config home-cfgfile view-cfgdat #t))
view-cfgdat))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 |
(if (common:file-exists? mthome-cfgfile)
(read-config mthome-cfgfile view-cfgdat #t))
;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
(if (common:file-exists? home-cfgfile)
(read-config home-cfgfile view-cfgdat #t))
view-cfgdat))
;; accept an alist or hash table containing envvar/env value pairs (value of #f causes unset)
;; execute thunk in context of environment modified as per this list
;; restore env to prior state then return value of eval'd thunk.
;; ** this is not thread safe **
(define (common:with-env-vars delta-env-alist-or-hash-table thunk)
(let* ((delta-env-alist (if (hash-table? delta-env-alist-or-hash-table)
(hash-table->alist delta-env-alist-or-hash-table)
delta-env-alist-or-hash-table))
(restore-thunks
(filter
identity
(map (lambda (env-pair)
(let* ((env-var (car env-pair))
(new-val (cadr env-pair))
(current-val (get-environment-variable env-var))
(restore-thunk
(cond
((not current-val) (lambda () (unsetenv env-var)))
((not (string? new-val)) #f)
((eq? current-val new-val) #f)
(else
(lambda () (setenv env-var current-val))))))
;;(when (not (string? new-val))
;; (debug:print 0 *default-log-port* " PROBLEM: not a string: "new-val"\n from env-alist:\n"delta-env-alist)
;; (pp delta-env-alist)
;; (exit 1))
(cond
((not new-val) ;; modify env here
(unsetenv env-var))
((string? new-val)
(setenv env-var new-val)))
restore-thunk))
delta-env-alist))))
(let ((rv (thunk)))
(for-each (lambda (x) (x)) restore-thunks) ;; restore env to original state
rv)))
|
Modified configf.scm from [b1611ec83f] to [a91d357ccf].
| ︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
(define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$"))
;; read a line and process any #{ ... } constructs
(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:process-line l ht allow-system #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let* ((prestr (list-ref matchdat 1))
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
(cmd (list-ref matchdat 3))
(poststr (list-ref matchdat 4))
(result #f)
(start-time (current-seconds))
(cmdsym (string->symbol cmdtype))
(fullcmd (case cmdsym
((scheme scm) (conc "(lambda (ht)" cmd ")"))
| > > > > | | 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 |
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
(define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$"))
;; read a line and process any #{ ... } constructs
(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:system ht cmd)
(system cmd)
)
(define (configf:process-line l ht allow-system #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let* ((prestr (list-ref matchdat 1))
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
(cmd (list-ref matchdat 3))
(poststr (list-ref matchdat 4))
(result #f)
(start-time (current-seconds))
(cmdsym (string->symbol cmdtype))
(fullcmd (case cmdsym
((scheme scm) (conc "(lambda (ht)" cmd ")"))
((system) (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
((shell sh) (conc "(lambda (ht)(string-translate (shell \"" cmd "\") \"\n\" \" \"))"))
((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
((getenv gv) (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
((mtrah) (conc "(lambda (ht)"
" (let ((extra \"" cmd "\"))"
" (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
" (if (string-null? extra) \"\" \"/\")"
|
| ︙ | ︙ | |||
173 174 175 176 177 178 179 | 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)))))) | | > > > > > > > > > > > > > > > > | 177 178 179 180 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 |
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))))))
(define (configf:cfgdat->env-alist section cfgdat-ht allow-system)
(filter
(lambda (pair)
(let* ((var (car pair))
(val (cdr pair)))
(cons var
(cond
((and allow-system (procedure? val)) ;; if we decided to use something other than #t or #f for allow-system ('return-procs or 'return-string) , this may become problematic
(val))
((procedure? val) #f)
((string? val) val)
(else "#f")))))
(append
(hash-table-ref/default cfgdat-ht "default" '())
(if (equal? section "default") '() (hash-table-ref/default cfgdat-ht section '())))))
(define (calc-allow-system 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))
|
| ︙ | ︙ | |||
214 215 216 217 218 219 220 221 222 223 224 225 226 |
(hash-table-keys ht))))
ht)
;; 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
;; sections: #f => get all, else list of sections to gather
;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections
;;
| > > > > > | | | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 |
(hash-table-keys ht))))
ht)
;; 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)
;; allow-system:
;; #f - do not evaluate [system
;; #t - immediately evaluate [system and store result as string
;; 'return-procs -- return a proc taking ht as an argument that may be evaulated at some future time
;; 'return-string -- return a string representing a proc taking ht as an argument that may be evaulated at some future time
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
;; sections: #f => get all, else list of sections to gather
;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections
;;
(define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f)
(sections #f) (settings (make-hash-table)) (keep-filenames #f)
(post-section-procs '()) (apply-wildcards #t) )
(debug:print 9 *default-log-port* "START: " path)
(if (and (not (port? path))
(not (common:file-exists? path))) ;; for case where we are handed a port
(begin
(debug:print-info 1 *default-log-port* "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))
|
| ︙ | ︙ | |||
262 263 264 265 266 267 268 | (if (list? sections) ;; delete all sections except given when sections is provided (for-each (lambda (section) (if (not (member section sections)) (hash-table-delete! res section))) ;; we are using "" as a dumping ground and must remove it before returning the ht (hash-table-keys res))) (debug:print 9 *default-log-port* "END: " path) | | > | > > | > | > | | > > | > | | | | | | | | | | | | > > | | | | | | > | > > > > > > | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | > | | | > > | | | | | | | | | | | | | | | | | | | | | | | | > | > > > > | | | | | | > | > > > | > | | | | | | | | | > | > | > | | | | | | | | | | | | | | > > | 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 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 |
(if (list? sections) ;; delete all sections except given when sections is provided
(for-each
(lambda (section)
(if (not (member section sections))
(hash-table-delete! res section))) ;; we are using "" as a dumping ground and must remove it before returning the ht
(hash-table-keys res)))
(debug:print 9 *default-log-port* "END: " path)
res
) ;; retval
(regex-case
inl
(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-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
(common:nice-path
(conc (if curr-conf-dir
curr-conf-dir
".")
"/" include-file)))))
(if (common:file-exists? full-conf)
(begin
;; (push-directory conf-dir)
(debug:print 9 *default-log-port* "Including: " full-conf)
(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-name sections) settings) curr-section-name #f #f))
(begin
(debug:print '(2 9) #f "INFO: include file " include-file " not found (called from " path ")")
(debug:print 2 *default-log-port* " " full-conf)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
curr-section-name #f #f)))))
(configf:script-rx ( x include-script params);; handle-exceptions
;; exn
;; (begin
;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(if (and (common:file-exists? include-script)(file-execute-access? include-script))
(let* ((local-allow-system (calc-allow-system allow-system curr-section-name sections))
(env-delta (configf:cfgdat->env-alist curr-section-name res local-allow-system))
(new-inp-port
(common:with-env-vars
env-delta
(lambda ()
(open-input-pipe (conc include-script " " params))))))
(debug:print '(2 9) *default-log-port* "Including from script output: " include-script)
;; (print "We got here, calling read-config next. Port is: " new-inp-port)
(read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
(close-input-port new-inp-port)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(begin
(debug:print 0 *default-log-port* "Script not found or not exectutable: " include-script)
(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)
;; after gathering the vars for a section and if apply-wildcards is true and if there is a wildcard in the section name process wildcards
;; NOTE: we are processing the curr-section-name, NOT section-name.
(process-wildcards res curr-section-name)
(if (not (hash-table-ref/default res section-name #f))(hash-table-set! res section-name '())) ;; ensure that mere mention of a section is not lost
(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 "". NOPE: We need new strategy. Put stuff in correct sections and then delete all sections later.
section-name
#f #f)))
(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))
(local-allow-system (calc-allow-system allow-system curr-section-name sections))
(env-delta (configf:cfgdat->env-alist curr-section-name res local-allow-system))
(cmdres (process:cmd-run->list cmd delta-env-alist-or-hash-table: env-delta)) ;; BB: here is where [system is exec'd. needs to have env from other vars!
(delta (- (current-seconds) start-time))
(status (cadr cmdres))
(res (car cmdres)))
(debug:print-info 4 *default-log-port* "" inl "\n => " (string-intersperse res "\n"))
(if (not (eq? status 0))
(begin
(debug:print-error 0 *default-log-port* "problem with " inl ", return code " status
" output: " cmdres)))
(if (> delta 2)
(debug:print-info 0 *default-log-port* "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res)
(debug:print-info 9 *default-log-port* "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-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-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-no-val ( x key val)
(let* ((alist (hash-table-ref/default res curr-section-name '()))
(fval (or (if (string? val) val #f) ""))) ;; fval should be either "" or " " (one or more spaces)
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = #t")
(safe-setenv key fval)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key fval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections)
settings)
curr-section-name key #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 *default-log-port* "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 *default-log-port* " 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-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-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-error 0 *default-log-port* "problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
) ;; end loop
)))
;; 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 megatest-version.scm from [288fcfb74a] to [8a4188e408].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6435) |
Modified process.scm from [98aa9e5247] to [36b394cc1e].
| ︙ | ︙ | |||
73 74 75 76 77 78 79 |
(define (process:cmd-run-proc-each-line-alt cmd proc)
(let* ((fh (open-input-pipe cmd))
(res (port-proc->list fh proc))
(status (close-input-pipe fh)))
(if (eq? status 0) res #f)))
| | > > > | | | | | | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
(define (process:cmd-run-proc-each-line-alt cmd proc)
(let* ((fh (open-input-pipe cmd))
(res (port-proc->list fh proc))
(status (close-input-pipe fh)))
(if (eq? status 0) res #f)))
(define (process:cmd-run->list cmd #!key (delta-env-alist-or-hash-table '()))
(common:with-env-vars
delta-env-alist-or-hash-table
(lambda ()
(let* ((fh (open-input-pipe cmd))
(res (port->list fh))
(status (close-input-pipe fh)))
(list res status)))))
(define (port->list fh)
(if (eof-object? fh) #f
(let loop ((curr (read-line fh))
(result '()))
(if (not (eof-object? curr))
(loop (read-line fh)
(append result (list curr)))
|
| ︙ | ︙ |
Modified tests.scm from [171321d60f] to [03a30c9a87].
| ︙ | ︙ | |||
144 145 146 147 148 149 150 |
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
| | | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
(let* ((config (tests:get-testconfig test-name #f all-tests-registry 'return-procs))) ;; assuming no problems with immediate evaluation, this could be simplified ('return-procs -> #t)
(let ((instr (if config
(config-lookup config "requirements" "waiton")
(begin ;; No config means this is a non-existant test
(debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"")
(exit 1))))
(instr2 (if config
(config-lookup config "requirements" "waitor")
|
| ︙ | ︙ |