Overview
| Comment: | Creates diectories if does not exist for the disks/paths provided |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | create-disk |
| Files: | files | file ages | folders |
| SHA1: |
27a8f638a910eca20e09ad51deb3ea22 |
| User & Date: | raghavki on 2018-07-13 17:25:34 |
| Other Links: | branch diff | manifest | tags |
Context
|
2018-07-16
| ||
| 13:23 | Merged the create run area change. check-in: 83edad0b8e user: mrwellan tags: v1.65 | |
|
2018-07-13
| ||
| 17:25 | Creates diectories if does not exist for the disks/paths provided Leaf check-in: 27a8f638a9 user: raghavki tags: create-disk | |
|
2018-07-12
| ||
| 11:41 | Added localhost as fallback when checking for cpu load check-in: 10d6c50ecd user: mrwellan tags: v1.65 | |
Changes
Modified launch.scm from [46cdbaf4d6] to [53c1bc7991].
| ︙ | ︙ | |||
1123 1124 1125 1126 1127 1128 1129 |
(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))) ;; min size of 1000, seems tad dumb
(if res
(cdr res)
(begin
| | | > > > > > > > > > > > | | 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 |
(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))) ;; min size of 1000, seems tad dumb
(if res
(cdr res)
(begin
;; (if (common:low-noise-print 20 "No valid disks or no disk with enough space")
;; (debug:print-error 0 *default-log-port* "No valid disks found in megatest.config. Please add some to your [disks] section and ensure the directory exists and has enough space!\n You can change minspace in the [setup] section of megatest.config. Current setting is: " minspace))
;;(exit 1)
(if (null? disks)
(cons 1 (conc *toppath* "/runs"))
(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 #f (create-directory (cadr head) #t))))
(if result
result
(if (null? tail)
(cons 1 (conc *toppath* "/runs"))
(loop (car tail) (cdr tail)))))))))))))) ;; 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 (config-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)
|
| ︙ | ︙ |