18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
(set! *configdat* (if (car *configinfo*)(car *configinfo*) #f))
(set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f))
(if *toppath*
(setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
(debug:print 0 "ERROR: failed to find the top path to your run setup."))
*toppath*)
(define (setup-env-defaults db fname run-id . already-seen)
(let* ((keys (get-keys db))
(keyvals (get-key-vals db run-id))
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/"))
(confdat (read-config fname))
(whatfound (make-hash-table))
(sections (list "default" thekey)))
(debug:print 4 "Using key=\"" thekey "\"")
(for-each
(lambda (section)
(let ((section-dat (hash-table-ref/default confdat section #f)))
(if section-dat
(for-each
(lambda (envvar)
(hash-table-set! whatfound section (+ (hash-table-ref/default whatfound section 0) 1))
(setenv envvar (cadr (assoc envvar section-dat))))
(map car section-dat)))))
sections)
(if (and (not (null? already-seen))
(not (car already-seen)))
(begin
(debug:print 2 "Key settings found in runconfig.config:")
(for-each (lambda (fullkey)
(debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
sections)
(debug:print 2 "---")
(set! *already-seen-runconfig-info* #t)))))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
(set! *configdat* (if (car *configinfo*)(car *configinfo*) #f))
(set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f))
(if *toppath*
(setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
(debug:print 0 "ERROR: failed to find the top path to your run setup."))
*toppath*)
(define (get-best-disk confdat)
(let* ((disks (hash-table-ref/default confdat "disks" #f))
(best #f)
(bestsize 0))
(if disks
(for-each
(lambda (disk-num)
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
(if (not (equal? item-path ""))
(db:test-set-rundir! db run-id testname "" toptest-path))
(debug:print 2 "Setting up test run area")
(debug:print 2 " - creating run area in " dfullp)
(system (conc "mkdir -p " dfullp))
(debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
(system (conc "mkdir -p " lnkpath))
(if (file-exists? (conc lnkpath "/" testname))
(system (conc "rm -f " lnkpath "/" testname)))
(system (conc "ln -sf " dfullp " " lnkpath "/" testname))
(if (directory? dfullp)
(begin
(let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/"))
(status (system cmd)))
(if (not (eq? status 0))
(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
|
>
>
>
>
|
|
|
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(if (not (equal? item-path ""))
(db:test-set-rundir! db run-id testname "" toptest-path))
(debug:print 2 "Setting up test run area")
(debug:print 2 " - creating run area in " dfullp)
(system (conc "mkdir -p " dfullp))
(debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
(system (conc "mkdir -p " lnkpath))
;; I suspect this section was deleting test directories under some
;; wierd sitations
;; (if (file-exists? (conc lnkpath "/" testname))
;; (system (conc "rm -f " lnkpath "/" testname)))
(system (conc "ln -sf " dfullp " " lnkpath "/" testname))
(if (directory? dfullp)
(begin
(let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/"))
(status (system cmd)))
(if (not (eq? status 0))
(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
|