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
;; 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


(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f))
  (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))







>
>
|







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







|
>
>
>
>
>
>
>
>
>
|
|
|
|
|







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




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

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







|
>
>
>
>


|
>







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

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






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







>
>
>
>
>







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