Megatest

Check-in [22daf8e282]
Login
Overview
Comment:First pass at processing sections on the fly
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 22daf8e2825d6bb3b3fe8c0c72b4c9052bb8253c
User & Date: mrwellan on 2015-11-16 13:00:00
Other Links: branch diff | manifest | tags
Context
2015-12-03
22:46
Initial version of spublish check-in: 5f3d099673 user: matt tags: v1.60
2015-11-26
21:59
db refactor Closed-Leaf check-in: 7102506f8d user: matt tags: v1.60-db-refactor
2015-11-16
13:00
First pass at processing sections on the fly check-in: 22daf8e282 user: mrwellan tags: v1.60
2015-11-12
14:11
Be more lazy on running sync to megatest.db check-in: 27552d9089 user: mrwellan tags: v1.60
Changes

Modified configf.scm from [39454623be] to [e9f35be8ad].

174
175
176
177
178
179
180


181

182
183
184
185
186
187
188
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190







+
+
-
+







;; read a config file, returns hash table of alists

;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
;; sections: #f => get all, else list of sections to gather
;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
;;
(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f))
(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f)(post-section-procs '()))
  (debug:print-info 5 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory))
  (debug:print 9 "START: " path)
  (if (not (file-exists? path))
      (begin 
	(debug:print-info 1 "read-config - file not found " path " current path: " (current-directory))
	;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?
	#f) ;; (if (not ht)(make-hash-table) ht))
224
225
226
227
228
229
230
231
232
233
234
235
236















237
238
239
240
241
242
243
226
227
228
229
230
231
232






233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







							      (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
							      ;; (pop-directory)
							      (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))
							    (begin
							      (debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")")
							      (debug:print 2 "        " full-conf)
							      (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))))
	       (configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system settings)
							    ;; 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))
	       (configf:section-rx ( x section-name ) (begin
							;; call post-section-procs
							(for-each 
							 (lambda (dat)
							   (let ((patt (car dat))
								 (proc (cdr dat)))
							     (if (string-match patt curr-section-name)
								 (proc curr-section-name section-name ht path))))
							 post-section-procs)
							(loop (configf:read-line inp res allow-system settings)
							      ;; 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)))
	       (configf:key-sys-pr ( x key cmd      ) (if allow-system
							  (let ((alist    (hash-table-ref/default res curr-section-name '()))
								(val-proc (lambda ()
									    (let* ((start-time (current-seconds))
										   (cmdres     (cmd-run->list cmd))
										   (delta      (- (current-seconds) start-time))
										   (status     (cadr cmdres))
299
300
301
302
303
304
305
306





307
308
309


310
311
312
313
314
315
316
310
311
312
313
314
315
316

317
318
319
320
321
322
323

324
325
326
327
328
329
330
331
332







-
+
+
+
+
+


-
+
+







		     (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))))))))
  
;; pathenvvar will set the named var to the path of the config
(define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f))
  (let* ((curr-dir   (current-directory))
         (configinfo (find-config fname toppath: given-toppath))
	 (toppath    (car configinfo))
	 (configfile (cadr configinfo)))
	 (configfile (cadr configinfo))
	 (set-fields (lambda (curr-section next-section ht path)
		       (let ((field-names (keys:config-get-fields confdat))
			     (target      (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
			 (keys:target-set-args keys target #f)))))
    (if toppath (change-directory toppath)) 
    (if (and toppath pathenvvar)(setenv pathenvvar toppath))
    (let ((configdat  (if configfile (read-config configfile #f #t environ-patt: environ-patt) #f))) ;; (make-hash-table))))
    (let ((configdat  (if configfile 
			  (read-config configfile #f #t environ-patt: environ-patt (list (cons "^fields$" set-fields)) #f))))
      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

(define (config-lookup cfgdat section var)
  (if (hash-table? cfgdat)
      (let ((sectdat (hash-table-ref/default cfgdat section '())))
	(if (null? sectdat)

Modified megatest.scm from [246bdb6838] to [38d9e3f6ba].

314
315
316
317
318
319
320





321
322
323
324
325
326
327
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332







+
+
+
+
+








(if (and (not (null? remargs))
	 (not (or
	       (args:get-arg "-runstep"))
	      ;; add more args that use remargs here
	      ))
    (debug:print 0 "ERROR: Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))

;; immediately set MT_TARGET if -reqtarg or -target are available
;;
(let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
  (if targ (setenv "MT_TARGET" targ)))

;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *time-zero* (current-seconds))
(define *watchdog*
  (make-thread 
   (lambda ()