Megatest

Check-in [0a8acd77a1]
Login
Overview
Comment:corrected broken fix on config file reader
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0a8acd77a1c22e349cf659a36fe1553a283f1f45
User & Date: matt on 2011-07-13 07:37:32
Other Links: manifest | tags
Context
2011-07-13
10:15
Added proper updating of parent test status when sub tests are still running check-in: 3c4ef51e14 user: mrwellan tags: trunk
07:37
corrected broken fix on config file reader check-in: 0a8acd77a1 user: matt tags: trunk
2011-07-12
23:52
Forgot to close port in reading config files check-in: 3938623e50 user: matt tags: trunk
Changes

Modified configf.scm from [42efb1bc58] to [50f8f33c26].

41
42
43
44
45
46
47
48



49
50
51
52
53
54
55
	    (section-rx (regexp "^\\[(.*)\\]\\s*$"))
	    (blank-l-rx (regexp "^\\s*$"))
	    (key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
	    (key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
	    (comment-rx (regexp "^\\s*#.*")))
	(let loop ((inl               (read-line inp))
		   (curr-section-name "default"))
	  (if (eof-object? inl) res



	      (regex-case 
	       inl 
	       (comment-rx _                  (loop (read-line inp) curr-section-name))
	       (blank-l-rx _                  (loop (read-line inp) curr-section-name))
	       (include-rx ( x include-file ) (begin
						(read-config include-file res)
						(loop (read-line inp) curr-section-name)))







|
>
>
>







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
	    (section-rx (regexp "^\\[(.*)\\]\\s*$"))
	    (blank-l-rx (regexp "^\\s*$"))
	    (key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
	    (key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
	    (comment-rx (regexp "^\\s*#.*")))
	(let loop ((inl               (read-line inp))
		   (curr-section-name "default"))
	  (if (eof-object? inl) 
	      (begin
		(close-input-port inp)
		res)
	      (regex-case 
	       inl 
	       (comment-rx _                  (loop (read-line inp) curr-section-name))
	       (blank-l-rx _                  (loop (read-line inp) curr-section-name))
	       (include-rx ( x include-file ) (begin
						(read-config include-file res)
						(loop (read-line inp) curr-section-name)))
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
						(loop (read-line inp) curr-section-name)))
	       (key-val-pr ( x key val      ) (let ((alist (hash-table-ref/default res curr-section-name '())))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))
						(loop (read-line inp) curr-section-name)))
	       (else (debug:print 0 "ERROR: problem parsing " path ",\n   \"" inl "\"")
		     (loop (read-line inp) curr-section-name)))))
	(close-input-port inp))))
  
(define (find-and-read-config fname)
  (let* ((curr-dir   (current-directory))
         (configinfo (find-config fname))
	 (toppath    (car configinfo))
	 (configfile (cadr configinfo)))
    (if toppath (change-directory toppath)) 







|
<







74
75
76
77
78
79
80
81

82
83
84
85
86
87
88
						(loop (read-line inp) curr-section-name)))
	       (key-val-pr ( x key val      ) (let ((alist (hash-table-ref/default res curr-section-name '())))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))
						(loop (read-line inp) curr-section-name)))
	       (else (debug:print 0 "ERROR: problem parsing " path ",\n   \"" inl "\"")
		     (loop (read-line inp) curr-section-name))))))))

  
(define (find-and-read-config fname)
  (let* ((curr-dir   (current-directory))
         (configinfo (find-config fname))
	 (toppath    (car configinfo))
	 (configfile (cadr configinfo)))
    (if toppath (change-directory toppath))