Megatest

Diff
Login

Differences From Artifact [6c5cb2ed66]:

To Artifact [aae9f9c538]:


2841
2842
2843
2844
2845
2846
2847







2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865

2866
2867
2868
2869
2870
2871
2872
           (handle-exceptions
           exn
           #t ;; just ignore it, it might have died in the meantime so joining it will throw an exception
           (thread-join! thread))
           )))
   (hash-table-keys *common:thread-punchlist*)))









;; moved to common.scm as it is very megatest specific

;; pathenvvar will set the named var to the path of the config
(define (common: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 (if ht (common:get-fields ht) '()))
			     (target      (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
			 (debug:print-info 9 *default-log-port* "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
			 (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 post-section-procs: (list (cons "^fields$" set-fields)) #f))))

      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

;;;; return list (path fullpath configname)
(define (common:find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))







>
>
>
>
>
>
>




|



|
<
<
<
<
<



|
>







2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863





2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
           (handle-exceptions
           exn
           #t ;; just ignore it, it might have died in the meantime so joining it will throw an exception
           (thread-join! thread))
           )))
   (hash-table-keys *common:thread-punchlist*)))

;; Use this when switching to mtconfigf module in find-and-read-config
;;
(define (common:set-fields curr-section next-section ht path)
  (let ((field-names (if ht (common:get-fields ht) '()))
	(target      (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
    (debug:print-info 9 *default-log-port* "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
    (if (not (null? field-names))(keys:target-set-args field-names target #f))))

;; moved to common.scm as it is very megatest specific

;; pathenvvar will set the named var to the path of the config
(define (common:find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)(set-fields common:set-fields))
  (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
				       post-section-procs: (list (cons "^fields$" set-fields)) #f))))
      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

;;;; return list (path fullpath configname)
(define (common:find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))