| ︙ | | |
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
|
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
|
-
+
|
(list "MT_TEST_RUN_DIR" work-area)
(list "MT_TEST_NAME" test-name)
(list "MT_ITEM_INFO" (conc itemdat))
(list "MT_ITEMPATH" item-path)
(list "MT_RUNNAME" runname)
(list "MT_MEGATEST" megatest)
(list "MT_TARGET" target)
(list "MT_LINKTREE" (configf:lookup *configdat* "setup" "linktree"))
(list "MT_LINKTREE" (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))
(list "MT_TESTSUITENAME" (common:get-testsuite-name))))
(if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path)))
;; (change-directory top-path)
;; Can setup as client for server mode now
;; (client:setup)
|
| ︙ | | |
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
|
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
|
-
+
|
(define (launch:cache-config)
;; if we have a linktree and -runtests and -target and the directory exists dump the config
;; to megatest-(current-seconds).cfg and symlink it to megatest.cfg
(if (and *configdat*
(or (args:get-arg "-run")
(args:get-arg "-runtests")
(args:get-arg "-execute")))
(let* ((linktree (get-environment-variable "MT_LINKTREE"))
(let* ((linktree (common:get-linktree)) ;; (get-environment-variable "MT_LINKTREE"))
(target (common:args-get-target exit-if-bad: #t))
(runname (or (args:get-arg "-runname")
(args:get-arg ":runname")
(getenv "MT_RUNNAME")))
(fulldir (conc linktree "/"
target "/"
runname)))
|
| ︙ | | |
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
|
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
|
+
-
+
+
|
(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*
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
(configf:lookup *configdat* "setup" "linktree")
(conc *toppath* "/lt"))))
(second-pass (find-and-read-config
mtconfig
environ-patt: "env-override"
given-toppath: toppath
pathenvvar: "MT_RUN_AREA_HOME"))
(runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config
(for-each (lambda (kt)
|
| ︙ | | |
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
|
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
|
-
+
-
|
(set! *runconfigdat* rdat)
(set! *toppath* toppath)
(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")
(let* ((linktree (common:get-linktree)))
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))))
|
| ︙ | | |
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
|
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
|
+
-
-
+
+
+
|
(test-base (conc testtop-base (if not-iterated "" "/") item-path))
;; nb// if itempath is not "" then it is prefixed with "/"
(toptest-path (conc disk-path (if contour (conc "/" contour) "") "/" testtop-base))
(test-path (conc disk-path (if contour (conc "/" contour) "") "/" test-base))
;; ensure this exists first as links to subtests must be created there
(linktree (common:get-linktree))
(linktree (let ((rd (config-lookup *configdat* "setup" "linktree")))
(if rd rd (conc *toppath* "/runs"))))
;; WAS: (let ((rd (config-lookup *configdat* "setup" "linktree")))
;; (if rd rd (conc *toppath* "/runs"))))
;; which seems wrong ...
(lnkbase (conc linktree (if contour (conc "/" contour) "") "/" target "/" runname))
(lnkpath (conc lnkbase "/" testname))
(lnkpathf (conc lnkpath (if not-iterated "" "/") item-path))
(lnktarget (conc lnkpath "/" item-path)))
;; Update the rundir path in the test record for all, rundir=physical, shortdir=logical
|
| ︙ | | |