Megatest

Check-in [a2ae1961df]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-runvar | items-runconfigvars-good-here
Files: files | file ages | folders
SHA1: a2ae1961df98c165ee479a4d8e612bef707f6f27
User & Date: bjbarcla on 2017-10-20 17:34:53
Other Links: branch diff | manifest | tags
Context
2017-10-20
18:17
removed envdelta stuff that was a dead end check-in: 48b44ebc9c user: bjbarcla tags: v1.64-runvar
17:34
wip check-in: a2ae1961df user: bjbarcla tags: v1.64-runvar, items-runconfigvars-good-here
16:55
wip check-in: bc923dd185 user: bjbarcla tags: v1.64-runvar
Changes

Modified common.scm from [ccefd78277] to [ec7c4778b7].

2329
2330
2331
2332
2333
2334
2335

2336
2337
2338
2339
2340
2341
2342




2343


2344
2345
2346




2347
2348
2349
2350
2351
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







+



-
-
-
-
+
+
+
+

+
+
-
-
-
+
+
+
+





           (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))
                    ;;(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
                    (if (not new-val)  ;; modify env here
                        (unsetenv env-var)
                        (setenv env-var new-val))
                     ((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)))