Overview
| Comment: | Preserve vars and reset them when doing items manipulations.: |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.70-defunct-try |
| Files: | files | file ages | folders |
| SHA1: |
e84ced5564ec29b53a791c8a8c0bc81e |
| User & Date: | mrwellan on 2019-12-11 16:57:44 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-12-11
| ||
| 20:20 | Moved couple procs from runs-inc into runsmod. check-in: e6296edad4 user: matt tags: v1.70-defunct-try | |
| 16:57 | Preserve vars and reset them when doing items manipulations.: check-in: e84ced5564 user: mrwellan tags: v1.70-defunct-try | |
| 11:43 | Baby steps, moved couple defstructs into runsmod. check-in: 3c181b6745 user: mrwellan tags: v1.70-defunct-try | |
Changes
Modified commonmod.scm from [f35a4b6429] to [1a18aaecd2].
| ︙ | ︙ | |||
572 573 574 575 576 577 578 | (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val) (setenv key val)) (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)))) (define home (getenv "HOME")) (define user (getenv "USER")) | > > > > > > > > > > > > | | | 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 |
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
(setenv key val))
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; put any changed environment variables back to how they were - TODO - turn this into some sort of with-
(define (common:set-vars-back all-vars)
(for-each
(lambda (vardat)
(let ((var (car vardat))
(val (cdr vardat)))
(if (not (equal? (get-environment-variable var) val))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "Failed to set " var " to " val)
(setenv var val)))))
all-vars))
;; returns list of fd count, socket count
(define (get-file-descriptor-count #!key (pid (current-process-id )))
(list
(length (glob (conc "/proc/" pid "/fd/*")))
(length (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
)
)
|
| ︙ | ︙ |
Modified runs-inc.scm from [90e532b08a] to [3ca2461ce8].
| ︙ | ︙ | |||
1713 1714 1715 1716 1717 1718 1719 | (define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry) ;; All these vars might be referenced by the testconfig file reader (let* ((test-name (tests:testqueue-get-testname test-record)) (test-waitons (tests:testqueue-get-waitons test-record)) (itemdat (tests:testqueue-get-itemdat test-record)) (item-path "") (db #f) | | > | 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 |
(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:testqueue-get-waitons test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(item-path "")
(db #f)
(full-test-name #f)
(all-vars (get-environment-variables)))
;; setting itemdat to a list if it is #f
(if (not itemdat)(set! itemdat '()))
(set! item-path (item-list->path itemdat))
(set! full-test-name (db:test-make-full-name test-name item-path))
(runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) ;; these may be needed by the launching process
(let* ((test-conf ;; re-instate the tests:get-testconfig once the kinks are worked out. FIXME!!!
;; (tests:get-testconfig test-name item-path all-tests-registry #t force-create: #t))
|
| ︙ | ︙ | |||
1859 1860 1861 1862 1863 1864 1865 | (let* ((files (string-split (configf:lookup test-conf "skip" "fileexists"))) (existing (filter common:file-exists? files))) (if (not (null? existing)) ;; (common:file-exists? (configf:lookup test-conf "skip" "fileexists")) (set! skip-test (conc "Skipping due to existance of file(s) " (string-intersperse existing ", ")))))) ;; (configf:lookup test-conf "skip" "fileexists"))))) ((and skip-check (configf:lookup test-conf "skip" "filenotexists")) | | | 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 | (let* ((files (string-split (configf:lookup test-conf "skip" "fileexists"))) (existing (filter common:file-exists? files))) (if (not (null? existing)) ;; (common:file-exists? (configf:lookup test-conf "skip" "fileexists")) (set! skip-test (conc "Skipping due to existance of file(s) " (string-intersperse existing ", ")))))) ;; (configf:lookup test-conf "skip" "fileexists"))))) ((and skip-check (configf:lookup test-conf "skip" "filenotexists")) (let* ((files (string-split (configf:lookup test-conf "skip" "filenotexists"))) (existing (filter common:file-exists? files))) (if (null? existing) ;; (common:file-exists? (configf:lookup test-conf "skip" "filenotexists"))) (set! skip-test (conc "Skipping due to non existance of files " (string-intersperse files ", ")))))) ;; (configf:lookup test-conf "skip" "filenotexists"))))) ((and skip-check (configf:lookup test-conf "skip" "script")) (if (= (system (configf:lookup test-conf "skip" "script")) 0) |
| ︙ | ︙ | |||
1913 1914 1915 1916 1917 1918 1919 | ;; (debug:print 2 *default-log-port* "NOTE: " test-name " is already running"))) (else (debug:print-error 0 *default-log-port* "Failed to launch test " full-test-name ". Unrecognised state " (test:get-state testdat)) (case (string->symbol (test:get-state testdat)) ((COMPLETED INCOMPLETE) (hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)) (else | | > > > > > > > > > > > > > | 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 |
;; (debug:print 2 *default-log-port* "NOTE: " test-name " is already running")))
(else
(debug:print-error 0 *default-log-port* "Failed to launch test " full-test-name ". Unrecognised state " (test:get-state testdat))
(case (string->symbol (test:get-state testdat))
((COMPLETED INCOMPLETE)
(hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN))
(else
(hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)))))))
;; put any changed environment variables back to how they were - TODO - turn this into some sort of with-
(common:set-vars-back all-vars)
#;(for-each
(lambda (vardat)
(let ((var (car vardat))
(val (cdr vardat)))
(if (not (equal? (get-environment-variable var) val))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "Failed to set " var " to " val)
(setenv var val)))))
all-vars)
))
;;======================================================================
;; END OF NEW STUFF
;;======================================================================
(define (get-dir-up-n dir . params)
(let ((dparts (string-split dir "/"))
|
| ︙ | ︙ |