Overview
Comment: | updated env-delta calculator to honor allow-system; bumped version to 1.6435 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64-runvar |
Files: | files | file ages | folders |
SHA1: |
d6d1370c8374e813aca7a3ed0e56f50a |
User & Date: | bjbarcla on 2017-10-23 14:51:39 |
Other Links: | branch diff | manifest | tags |
Context
2017-10-23
| ||
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-20
| ||
18:17 | removed envdelta stuff that was a dead end check-in: 48b44ebc9c user: bjbarcla tags: v1.64-runvar | |
Changes
Modified configf.scm from [897b6d0f2a] to [a91d357ccf].
︙ | ︙ | |||
178 179 180 181 182 183 184 | (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)))))) | | | > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | (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) |
︙ | ︙ | |||
233 234 235 236 237 238 239 240 241 242 243 244 245 246 | (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 ;; (define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f) | > > > > > | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 | (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) |
︙ | ︙ | |||
325 326 327 328 329 330 331 | 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)) | > | | 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 | 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) |
︙ | ︙ | |||
366 367 368 369 370 371 372 | 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)) | > | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 | 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 |
︙ | ︙ |
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 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") |
︙ | ︙ |