750
751
752
753
754
755
756
757
758
759
760
761
762
763
|
(set! *toppath* (or toppath (cadr first-pass))) ;; use the gathered data unless already have it
(set! toppath *toppath*)
(if (not *toppath*)
(begin
(debug:print-error 0 *default-log-port* "you are not in a megatest area!")
(exit 1)))
(setenv "MT_RUN_AREA_HOME" *toppath*)
;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it
(let* ((keys (rmt:get-keys))
(key-vals (keys:target->keyval keys target))
(linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
(second-pass (find-and-read-config
mtconfig
|
>
|
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
|
(set! *toppath* (or toppath (cadr first-pass))) ;; use the gathered data unless already have it
(set! toppath *toppath*)
(if (not *toppath*)
(begin
(debug:print-error 0 *default-log-port* "you are not in a megatest area!")
(exit 1)))
(setenv "MT_RUN_AREA_HOME" *toppath*)
(setenv "MT_TESTSUITENAME" (common:get-testsuite-name))
;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it
(let* ((keys (rmt:get-keys))
(key-vals (keys:target->keyval keys target))
(linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
(second-pass (find-and-read-config
mtconfig
|
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
|
(set! *configstatus* 'partial))
(begin
(debug:print-error 0 *default-log-port* "No " mtconfig " file found. Giving up.")
(exit 2))))))
;; additional house keeping
(let* ((linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))))
(if linktree
(begin
(if (not (file-exists? linktree))
(begin
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(exit 1))
(create-directory linktree #t))))
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)))
(let ((tlink (conc *toppath* "/lt")))
(if (not (file-exists? tlink))
(create-symbolic-link linktree tlink)))))
(begin
(debug:print-error 0 *default-log-port* "linktree not defined in [setup] section of megatest.config")
)))
(if (and *toppath*
(directory-exists? *toppath*))
(setenv "MT_RUN_AREA_HOME" *toppath*)
(begin
(debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
*toppath*))
(define launch:setup launch:setup-new)
(define (get-best-disk confdat testconfig)
|
|
|
>
>
>
|
>
|
>
|
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
|
(set! *configstatus* 'partial))
(begin
(debug:print-error 0 *default-log-port* "No " mtconfig " file found. Giving up.")
(exit 2))))))
;; additional house keeping
(let* ((linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))))
(if (string? linktree)
(begin
(if (and (not (file-exists? linktree))
(file-write-access? (pathname-directory linktree)))
(begin
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(exit 1))
(create-directory linktree #t))))
;; now create the lt link in MT_RUN_AREA_HOME
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)))
(let ((tlink (conc *toppath* "/lt")))
(if (not (file-exists? tlink))
(if (file-write-access? *toppath*)
(create-symbolic-link linktree tlink))))))
(begin
(debug:print-error 0 *default-log-port* "linktree not defined in [setup] section of megatest.config")
)))
(if (and *toppath*
(directory-exists? *toppath*))
(begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(setenv "MT_TESTSUITENAME" (common:get-testsuite-name)))
(begin
(debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
*toppath*))
(define launch:setup launch:setup-new)
(define (get-best-disk confdat testconfig)
|