Megatest

Check-in [2316fa6bc4]
Login
Overview
Comment:Some fixes to address issues created by the per-section config processing code
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 2316fa6bc4f813491ab9e69aeb1e9c1cd38b2dd4
User & Date: mrwellan on 2016-01-06 09:48:16
Other Links: branch diff | manifest | tags
Context
2016-01-07
14:06
Add debug help line and remove junk at top of megatest.scm check-in: cf6182b1fe user: mrwellan tags: v1.60
2016-01-06
15:31
Create new branch named "rpc-support" Closed-Leaf check-in: d223d55c09 user: bjbarcla tags: rpc-transport
09:48
Some fixes to address issues created by the per-section config processing code check-in: 2316fa6bc4 user: mrwellan tags: v1.60
2015-12-17
14:31
Needed to follow links by default in sretrieve check-in: 15bf67d66a user: mrwellan tags: v1.60
Changes

Modified configf.scm from [e9f35be8ad] to [6f6eea6687].

233
234
235
236
237
238
239
240

241
242
243
244
245
246
247
233
234
235
236
237
238
239

240
241
242
243
244
245
246
247







-
+







	       (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))))
								 (proc curr-section-name section-name res 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)))
312
313
314
315
316
317
318
319

320

321

322
323
324
325

326
327
328
329
330
331
332
312
313
314
315
316
317
318

319
320
321

322
323
324
325

326
327
328
329
330
331
332
333







-
+

+
-
+



-
+







;; 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))
		       (let ((field-names (if ht (keys:config-get-fields ht) '()))
			     (target      (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
			 (debug:print-info 9 "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
			 (keys:target-set-args keys target #f)))))
			 (if (not (null? field-names))(keys:target-set-args field-names 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))))
			  (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (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 keys.scm from [e5c8c45be0] to [b0a1fb8bc8].

33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48










49
50
51
52
53
54
55
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







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







;; This invalidates using "/" in item names. Every key will be
;; available via args:get-arg as :keyfield. Since this only needs to
;; be called once let's use it to set the environment vars
;;
;; The setting of :keyfield in args should be turned off ASAP
;;
(define (keys:target-set-args keys target ht)
  (if target
  (let ((vals (string-split target "/")))
    (if (eq? (length vals)(length keys))
	(for-each (lambda (key val)
		    (setenv key val)
		    (hash-table-set! ht (conc ":" key) val))
		  keys
		  vals)
	(debug:print 0 "ERROR: wrong number of values in " target ", should match " keys))
    vals))
      (let ((vals (string-split target "/")))
	(if (eq? (length vals)(length keys))
	    (for-each (lambda (key val)
			(setenv key val)
			(if ht (hash-table-set! ht (conc ":" key) val)))
		      keys
		      vals)
	    (debug:print 0 "ERROR: wrong number of values in " target ", should match " keys))
	vals)
      (debug:print 4 "ERROR: keys:target-set-args called with no target.")))

;; given the keys (a list of vectors <key field> or a list of keys) and a target return a keyval list
;; keyval list ( (key1 val1) (key2 val2) ...)
(define (keys:target->keyval keys target)
  (let* ((targlist (string-split target "/"))
	 (numkeys  (length keys))
	 (numtarg  (length targlist))