768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
|
(target (common:args-get-target))
(linktree (common:get-linktree))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config
(rundir (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
(mtcachef (and rundir (conc rundir "/" ".megatest.cfg-" megatest-version "-" megatest-fossil-hash)))
(rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash)))
(cancreate (and rundir (file-exists? rundir)(file-write-access? rundir)))
(cxt (hash-table-ref/default *contexts* toppath #f)))
;; create our cxt for this area if it doesn't already exist
(if (not cxt)(hash-table-set! *contexts* toppath (make-cxt)))
;; (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef)
(set! *toppath* toppath) ;; This is needed when we are running as a test using CMDINFO as a datasource
(cond
;; data was read and cached and available in *configstatus*, toppath has already been set
((eq? *configstatus* 'fulldata)
*toppath*)
;; if mtcachef exists just read it, however we need to assume toppath is available in $MT_RUN_AREA_HOME
((and mtcachef (file-exists? mtcachef) (get-environment-variable "MT_RUN_AREA_HOME") use-cache)
(set! *configdat* (configf:read-alist mtcachef))
(set! *runconfigdat* (configf:read-alist rccachef))
(set! *configinfo* (list *configdat* (get-environment-variable "MT_RUN_AREA_HOME")))
(set! *configstatus* 'fulldata)
(set! *toppath* (get-environment-variable "MT_RUN_AREA_HOME"))
*toppath*)
;; we have all the info needed to fully process runconfigs and megatest.config
|
|
|
|
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
|
(target (common:args-get-target))
(linktree (common:get-linktree))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config
(rundir (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
(mtcachef (and rundir (conc rundir "/" ".megatest.cfg-" megatest-version "-" megatest-fossil-hash)))
(rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash)))
(cancreate (and rundir (common:file-exists? rundir)(file-write-access? rundir)))
(cxt (hash-table-ref/default *contexts* toppath #f)))
;; create our cxt for this area if it doesn't already exist
(if (not cxt)(hash-table-set! *contexts* toppath (make-cxt)))
;; (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef)
(set! *toppath* toppath) ;; This is needed when we are running as a test using CMDINFO as a datasource
(cond
;; data was read and cached and available in *configstatus*, toppath has already been set
((eq? *configstatus* 'fulldata)
*toppath*)
;; if mtcachef exists just read it, however we need to assume toppath is available in $MT_RUN_AREA_HOME
((and mtcachef (common:file-exists? mtcachef) (get-environment-variable "MT_RUN_AREA_HOME") use-cache)
(set! *configdat* (configf:read-alist mtcachef))
(set! *runconfigdat* (configf:read-alist rccachef))
(set! *configinfo* (list *configdat* (get-environment-variable "MT_RUN_AREA_HOME")))
(set! *configstatus* 'fulldata)
(set! *toppath* (get-environment-variable "MT_RUN_AREA_HOME"))
*toppath*)
;; we have all the info needed to fully process runconfigs and megatest.config
|
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
|
(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))
|
|
|
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
|
(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 (common: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))
|
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
|
(lnktarget (conc lnkpath "/" item-path)))
;; Update the rundir path in the test record for all, rundir=physical, shortdir=logical
;; rundir shortdir
(rmt:general-call 'test-set-rundir-shortdir run-id lnkpathf test-path testname item-path run-id)
(debug:print 2 *default-log-port* "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path)
(if (not (file-exists? linktree))
(begin
(debug:print 0 *default-log-port* "WARNING: linktree did not exist! Creating it now at " linktree)
(create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree))))
;; create the directory for the tests dir links, this is needed no matter what...
(if (and (not (directory-exists? lnkbase))
(not (file-exists? lnkbase)))
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase)
(print-error-message exn (current-error-port)))
(create-directory lnkbase #t)))
|
|
|
|
|
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
|
(lnktarget (conc lnkpath "/" item-path)))
;; Update the rundir path in the test record for all, rundir=physical, shortdir=logical
;; rundir shortdir
(rmt:general-call 'test-set-rundir-shortdir run-id lnkpathf test-path testname item-path run-id)
(debug:print 2 *default-log-port* "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path)
(if (not (common:file-exists? linktree))
(begin
(debug:print 0 *default-log-port* "WARNING: linktree did not exist! Creating it now at " linktree)
(create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree))))
;; create the directory for the tests dir links, this is needed no matter what...
(if (and (not (common:directory-exists? lnkbase))
(not (common:file-exists? lnkbase)))
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase)
(print-error-message exn (current-error-port)))
(create-directory lnkbase #t)))
|