Overview
| Comment: | Partial fix for #{shell ...} problem in testconfigs |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-shell-problem | v1.65-broken |
| Files: | files | file ages | folders |
| SHA1: |
3ccc64251fcfc210fe7ba1998fa90a96 |
| User & Date: | mrwellan on 2020-04-30 22:44:51 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-05-01
| ||
| 15:58 | Upped allowed time for reading cached load data to 10 sec. The load is over a 60 sec. window, does 10 seconds really make a difference? check-in: 6625f3bc6a user: mrwellan tags: v1.65-shell-problem, v1.65-broken | |
|
2020-04-30
| ||
| 22:44 | Partial fix for #{shell ...} problem in testconfigs check-in: 3ccc64251f user: mrwellan tags: v1.65-shell-problem, v1.65-broken | |
| 16:22 | rewrite absurdly long log file names if over 250 chars long check-in: 0a9e690b28 user: mrwellan tags: v1.65-broken | |
Changes
Modified tests.scm from [bf1af44b82] to [fbd7ebda22].
| ︙ | ︙ | |||
166 167 168 169 170 171 172 |
(items:get-items-from-config tconfig))
(else #f)))) ;; not iterated
;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
| | | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 |
(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 #t))) ;;'return-procs))) ;; assuming no problems with immediate evaluation, this could be simplified ('return-procs -> #t)
(let ((instr (if config
(configf: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
(configf:lookup config "requirements" "waitor")
|
| ︙ | ︙ | |||
1577 1578 1579 1580 1581 1582 1583 |
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
test-name "/" item-path))
(local-tcfg (conc local-tcdir "/testconfig")))
(if (common:file-exists? local-tcfg)
local-tcdir
#f))
| > > | > < | < | < | | > | | 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 |
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
test-name "/" item-path))
(local-tcfg (conc local-tcdir "/testconfig")))
(if (common:file-exists? local-tcfg)
local-tcdir
#f))
(begin
(debug:print-info 0 *default-log-port* "reading testconfig for "test-full-name" from tests/"test-name" directory.")
(conc *toppath* "/tests/" test-name)) ;; should this fallback exist?
))
(test-configf (conc test-path "/testconfig"))
(testexists (let loopa ((tries-left 30))
(cond
((and (common:file-exists? test-configf)(file-read-access? test-configf))
#t)
((common:file-exists? test-configf)
(debug:print 0 *default-log-port* "WARNING: Cannot read testconfig file: "test-configf)
#f)
((and wait-a-minute (> tries-left 0))
(thread-sleep! 10)
(debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf
" will retry in 10 seconds. Tries left: "tries-left) ;; BB: this fires
(loopa (sub1 tries-left)))
(else
(debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
#f))))
(tcfg (if testexists
(configf:read-file test-configf #f system-allowed
environ-patt: (if system-allowed
"pre-launch-env-vars"
#f))
#f)))
(if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
(if tcfg (hash-table-set! *testconfigs* test-full-name tcfg))
(if (and testexists
|
| ︙ | ︙ |