Megatest

Diff
Login

Differences From Artifact [d367925a31]:

To Artifact [c20e1b3984]:


778
779
780
781
782
783
784
785

786
787
788
789
790
791
792
793
794
795

796
797
798
799
800
801
802
778
779
780
781
782
783
784

785
786
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802







-
+









-
+







	     (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)))
	 (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
	 ;; 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)
     ((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
869
870
871
872
873
874
875
876

877
878
879
880
881
882
883
869
870
871
872
873
874
875

876
877
878
879
880
881
882
883







-
+







		(begin
		  (debug:print-error 0 *default-log-port* "No " mtconfig " file found. Giving up.")
		  (exit 2))))))
	;; additional house keeping
	(let* ((linktree (common:get-linktree)))
	  (if linktree
	      (begin
		(if (not (file-exists? linktree))
	    (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))
965
966
967
968
969
970
971
972

973
974
975
976
977
978


979
980
981
982
983
984
985
965
966
967
968
969
970
971

972
973
974
975
976


977
978
979
980
981
982
983
984
985







-
+




-
-
+
+







	 (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))
    (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 (directory-exists? lnkbase))
	     (not (file-exists? lnkbase)))
    (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)))