Megatest

Check-in [d72d1dc4b8]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added push/pop dir to *toppath* in runconfigs for consistent loading of runconfigs
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | development
Files: files | file ages | folders
SHA1: d72d1dc4b867725939f49e316c78c26d9932bdfa
User & Date: mrwellan on 2013-04-10 18:11:30
Other Links: branch diff | manifest | tags
Context
2013-04-10
22:45
Added launch speed test and fdk compatibility test check-in: 6964f022fb user: matt tags: development
18:11
Added push/pop dir to *toppath* in runconfigs for consistent loading of runconfigs check-in: d72d1dc4b8 user: mrwellan tags: development
16:43
Re-did config file path handling, removed directory-push/directory-pop for syle more consistent with old behavior check-in: 7906872d60 user: mrwellan tags: development
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [fc2e76989a] to [02a5ef0a9a].

︙
144
145
146
147
148
149
150






151
152
153
154
155
156
157

144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163








+
+
+
+
+
+








  (hash-table-ref/default 
   (read-config "megatest.config" #f #t)
   "disks" '("none" "")))

;;======================================================================
;; System stuff
;;======================================================================

;; return a nice clean pathname made absolute
(define (nice-path dir)
  (normalize-pathname (if (absolute-pathname? dir)
			  dir
			  (conc (current-directory) "/" dir))))

(define (get-df path)
  (let* ((df-results (cmd-run->list (conc "df " path)))
	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
	 (freespc    #f))
    ;; (write df-results)
    (for-each (lambda (l)
︙

Modified configf.scm from [ee796a94b9] to [34fdb76110].

︙
146
147
148
149
150
151
152
153
154
155
156





157
158
159
160
161
162
163
164
165
166


167
168
169
170
171
172
173

146
147
148
149
150
151
152




153
154
155
156
157


158
159
160
161
162
163
164

165
166
167
168
169
170
171
172
173








-
-
-
-
+
+
+
+
+
-
-







-
+
+








		(close-input-port inp)
		(hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht
		res)
	      (regex-case 
	       inl 
	       (configf:comment-rx _                  (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
	       (configf:blank-l-rx _                  (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
	       (configf:include-rx ( x include-file ) (let* ((curr-dir  (current-directory))
							     (full-conf (if (absolute-pathname? include-file)
									    include-file
									    (conc curr-dir "/" include-file)))
	       (configf:include-rx ( x include-file ) (let* ((curr-conf-dir (pathname-directory path))
							     (full-conf     (if (absolute-pathname? include-file)
										include-file
										(nice-path 
										 (conc curr-conf-dir "/" include-file)))))
							     (conf-dir (pathname-directory include-file))
							     (incfname (pathname-strip-directory include-file))) 
							(if (file-exists? full-conf)
							    (begin
							      ;; (push-directory conf-dir)
							      (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections)
							      ;; (pop-directory)
							      (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
							    (begin
							      (debug:print 0 "INFO: include file " include-file " not found (called from " path ")")
							      (debug:print 2 "INFO: include file " include-file " not found (called from " path ")")
							      (debug:print 2 "        " full-conf)
							      (loop (configf:read-line inp res allow-system) curr-section-name #f #f)))))
	       (configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system)
							    ;; if we have the sections list then force all settings into "" and delete it later?
							    (if (or (not sections) 
								    (member section-name sections))
								section-name "") ;; stick everything into ""
							    #f #f))
︙

Modified runconfig.scm from [09fb252607] to [d27b298e19]. 

1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5

6
7
8
9
10
11
12
13






-
+








;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format)
(use format directory-utils)

(declare (unit runconfig))
(declare (uses common))

(include "common_records.scm")
︙
58
59
60
61
62
63
64

65
66
67
68

69
70
71
72
73
74
75
76

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78








+




+









		      (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)))
    finaldat))

(define (set-run-config-vars db run-id keys keyvals)
  (push-directory *toppath*)
  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))
	(targ       (or (args:get-arg "-target")
			(args:get-arg "-reqtarg")
			(db:get-target db run-id))))
    (pop-directory)
    (if (file-exists? runconfigf)
	(setup-env-defaults runconfigf run-id #t keys keyvals
			    environ-patt: (conc "(default"
						(if targ
						    (conc "|" targ ")")
						    ")")))
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))

This page was generated in about 0.118s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00