Overview
| Comment: | Fixed behavior when disks are non-existent. https://hsdes.intel.com/appstore/article/#/14015976511 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
e96d85c5b37382432ee06a40614f27eb |
| User & Date: | mmgraham on 2022-03-19 17:38:31 |
| Other Links: | branch diff | manifest | tags |
Context
|
2022-03-21
| ||
| 10:43 | Added HOSTNAME to the env var blacklist check-in: fcd5c35b2a user: mmgraham tags: v1.65 | |
|
2022-03-19
| ||
| 17:38 | Fixed behavior when disks are non-existent. https://hsdes.intel.com/appstore/article/#/14015976511 check-in: e96d85c5b3 user: mmgraham tags: v1.65 | |
|
2022-03-17
| ||
| 09:06 | Added ezsteps.status file to tests with ezsteps check-in: 35ad12134a user: mmgraham tags: v1.65 | |
Changes
Modified launch.scm from [1f3f892cd5] to [1931a96c9c].
| ︙ | ︙ | |||
1155 1156 1157 1158 1159 1160 1161 |
(define (get-best-disk confdat testconfig)
(let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
(hash-table-ref/default confdat "disks" #f)))
(minspace (let ((m (configf:lookup confdat "setup" "minspace")))
(string->number (or m "10000")))))
(if disks
| | > | | < < | > > > > | > | > > > > > | > > | 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 |
(define (get-best-disk confdat testconfig)
(let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
(hash-table-ref/default confdat "disks" #f)))
(minspace (let ((m (configf:lookup confdat "setup" "minspace")))
(string->number (or m "10000")))))
(if disks
(let ((res (common:get-disk-with-most-free-space disks minspace)))
(if res
(cdr res)
;; else if no valid disks...
(begin
(debug:print 0 *default-log-port* "WARNING: No valid disks or no disk with enough space found from " disks)
(if (null? disks)
(cons 1 (conc *toppath* "/runs"))
;; else try to create the directories anyway.
(let ((paths (sort disks (lambda (x y) (> (string-length (cadr x)) (string-length (cadr y)))))))
(let loop ((head (car paths)) (tail (cdr paths)))
(let ((result (handle-exceptions exn
(begin
(debug:print 0 *default-log-port* "failed to create dir " (cadr head) ", exn=" exn)
#f)
(create-directory (cadr head) #t))))
(if result
result
(if (null? tail)
(begin
(debug:print 0 *default-log-port* "Using toppath/runs")
(conc *toppath* "/runs")
)
(loop (car tail) (cdr tail))))))
)
) ;; if null? disks
) ;; if not res
)
)
;; no disks definition - use toppath/runs, fall back to currdir/runs
(let* ((toppath (or *toppath*
(common:get-toppath *toppath*)
(begin
(debug:print-error 0 *default-log-port* "Creating runs dir in current directory, this is probably not what you wanted. Please check your setup.")
(current-directory))))
(runsdir (conc toppath "/runs")))
(if (not (file-exists? runsdir))(create-directory runsdir))
runsdir)
))) ;; the code creates the necessary directories if it does not exist and returns the path.
(define (launch:test-copy test-src-path test-path)
(let* ((ovrcmd (let ((cmd (configf:lookup *configdat* "setup" "testcopycmd")))
(if cmd
;; substitute the TEST_SRC_PATH and TEST_TARG_PATH
(string-substitute "TEST_TARG_PATH" test-path
(string-substitute "TEST_SRC_PATH" test-src-path cmd #t) #t)
|
| ︙ | ︙ | |||
1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 |
;; prevent overlapping actions - set to LAUNCHED as early as possible
;;
;; the following call handles waiver propogation. cannot yet condense into roll-up-pass-fail
(tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
(rmt:set-state-status-and-roll-up-items run-id test-name item-path #f "LAUNCHED" #f)
;; (pp (hash-table->alist tconfig))
(set! diskpath (get-best-disk *configdat* tconfig))
(if diskpath
(let ((dat (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
(set! work-area (car dat))
(set! toptest-work-area (cadr dat))
(debug:print-info 2 *default-log-port* "Using work area " work-area))
(begin
(set! work-area (conc test-path "/tmp_run"))
| > | 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 |
;; prevent overlapping actions - set to LAUNCHED as early as possible
;;
;; the following call handles waiver propogation. cannot yet condense into roll-up-pass-fail
(tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
(rmt:set-state-status-and-roll-up-items run-id test-name item-path #f "LAUNCHED" #f)
;; (pp (hash-table->alist tconfig))
(set! diskpath (get-best-disk *configdat* tconfig))
(debug:print 2 *default-log-port* "best disk path = " diskpath)
(if diskpath
(let ((dat (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
(set! work-area (car dat))
(set! toptest-work-area (cadr dat))
(debug:print-info 2 *default-log-port* "Using work area " work-area))
(begin
(set! work-area (conc test-path "/tmp_run"))
|
| ︙ | ︙ |