Megatest

Check-in [7b83c40aec]
Login
Overview
Comment:Made default behavior to exit if toppath not found
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.64-aside
Files: files | file ages | folders
SHA1: 7b83c40aecf14e4fd1834004770e72b419a0c687
User & Date: matt on 2017-04-23 17:56:37
Other Links: branch diff | manifest | tags
Context
2017-04-23
17:56
Made default behavior to exit if toppath not found Closed-Leaf check-in: 7b83c40aec user: matt tags: v1.64-aside
2017-04-19
16:59
merged potential fix for signature 12 problem (1 in 200 issue with test crashing <this should not happen> where *configdat* is broken after (launch:setup) ) check-in: dd090afbe4 user: bjbarcla tags: v1.64, v1.6407
Changes

Modified launch.scm from [f64b41effe] to [42716c1617].

793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)
;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force-reread #f) (areapath #f))
  (mutex-lock! *launch-setup-mutex*)
  (if (and *toppath*
	   (eq? *configstatus* 'fulldata) (not force-reread)) ;; got it all
      (begin
	(debug:print 2 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata")
	(mutex-unlock! *launch-setup-mutex*)
	*toppath*)
      (let ((res (launch:setup-body force-reread: force-reread areapath: areapath)))
	(mutex-unlock! *launch-setup-mutex*)
	res)))

;; return paths depending on what info is available.
;;
(define (launch:get-cache-file-paths areapath toppath target mtconfig)
  (let* ((use-cache (common:use-cache?))







|







|







793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)
;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force-reread #f) (areapath #f)(exit-if-non-megatest-area #t))
  (mutex-lock! *launch-setup-mutex*)
  (if (and *toppath*
	   (eq? *configstatus* 'fulldata) (not force-reread)) ;; got it all
      (begin
	(debug:print 2 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata")
	(mutex-unlock! *launch-setup-mutex*)
	*toppath*)
      (let ((res (launch:setup-body force-reread: force-reread areapath: areapath exit-if-non-megatest-area: exit-if-non-megatest-area)))
	(mutex-unlock! *launch-setup-mutex*)
	res)))

;; return paths depending on what info is available.
;;
(define (launch:get-cache-file-paths areapath toppath target mtconfig)
  (let* ((use-cache (common:use-cache?))
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
                      "\n  rundir=" rundir 
                      "\n  testdir=" testdir 
                      "\n  cachedir=" cachedir
                      "\n  mtcachef=" mtcachef
                      "\n  rccachef=" rccachef)
    (cons mtcachef rccachef)))

(define (launch:setup-body #!key (force-reread #f) (areapath #f))
  (if (and (eq? *configstatus* 'fulldata)
	   *toppath*
	   (not force-reread)) ;; no need to reprocess
      *toppath*   ;; return toppath
      (let* ((use-cache (common:use-cache?)) ;; BB- use-cache checks *configdat* for use-cache setting.  We do not have *configdat*.  Bootstrapping problem here.
	     (toppath  (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
	     (target   (common:args-get-target))







|







832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
                      "\n  rundir=" rundir 
                      "\n  testdir=" testdir 
                      "\n  cachedir=" cachedir
                      "\n  mtcachef=" mtcachef
                      "\n  rccachef=" rccachef)
    (cons mtcachef rccachef)))

(define (launch:setup-body #!key (force-reread #f) (areapath #f)(exit-if-non-megatest-area #t))
  (if (and (eq? *configstatus* 'fulldata)
	   *toppath*
	   (not force-reread)) ;; no need to reprocess
      *toppath*   ;; return toppath
      (let* ((use-cache (common:use-cache?)) ;; BB- use-cache checks *configdat* for use-cache setting.  We do not have *configdat*.  Bootstrapping problem here.
	     (toppath  (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
	     (target   (common:args-get-target))
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
	 ((and (not force-reread) mtcachef (common:file-exists? mtcachef) (get-environment-variable "MT_RUN_AREA_HOME") use-cache)
          ;;(BB> "launch:setup-body -- cond branch 1 - use-cache")
          (set! *configdat*    (configf:read-alist mtcachef))
          ;;(BB> "launch:setup-body -- 1 set! *configdat*="*configdat*)
	  (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
	 ((and (not force-reread) mtcachef) ;; BB- why are we doing this without asking if caching is desired?
          ;;(BB> "launch:setup-body -- cond branch 2")
	  (let* ((first-pass    (find-and-read-config        ;; NB// sets MT_RUN_AREA_HOME as side effect
				 mtconfig
				 environ-patt: "env-override"
				 given-toppath: toppath







|
<







857
858
859
860
861
862
863
864

865
866
867
868
869
870
871
	 ((and (not force-reread) mtcachef (common:file-exists? mtcachef) (get-environment-variable "MT_RUN_AREA_HOME") use-cache)
          ;;(BB> "launch:setup-body -- cond branch 1 - use-cache")
          (set! *configdat*    (configf:read-alist mtcachef))
          ;;(BB> "launch:setup-body -- 1 set! *configdat*="*configdat*)
	  (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"))) ;; NOTE: the cond does NOT return the final result

	 ;; we have all the info needed to fully process runconfigs and megatest.config
	 ((and (not force-reread) mtcachef) ;; BB- why are we doing this without asking if caching is desired?
          ;;(BB> "launch:setup-body -- cond branch 2")
	  (let* ((first-pass    (find-and-read-config        ;; NB// sets MT_RUN_AREA_HOME as side effect
				 mtconfig
				 environ-patt: "env-override"
				 given-toppath: toppath
917
918
919
920
921
922
923


924
925
926
927
928
929
930
931
932
933
934
                         (mtcachef     (car cachefiles))
                         (rccachef     (cdr cachefiles)))
		    (if rccachef (configf:write-alist runconfigdat rccachef))
		    (set! *runconfigdat* runconfigdat)
		    (if mtcachef (configf:write-alist *configdat* mtcachef))
		    (if (and rccachef mtcachef) (set! *configstatus* 'fulldata))))
		;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table


		(begin (set! *configdat* (make-hash-table))
                       ;;(BB> "launch:setup-body -- 3 set! *configdat*="*configdat*)
                       )
		)))
	 ;; else read what you can and set the flag accordingly
	 (else
          ;;(BB> "launch:setup-body -- cond branch 3 - else")
	  (let* ((cfgdat   (find-and-read-config 
			    (or (args:get-arg "-config") "megatest.config")
			    environ-patt: "env-override"
			    given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")







>
>
|
<
<
<







916
917
918
919
920
921
922
923
924
925



926
927
928
929
930
931
932
                         (mtcachef     (car cachefiles))
                         (rccachef     (cdr cachefiles)))
		    (if rccachef (configf:write-alist runconfigdat rccachef))
		    (set! *runconfigdat* runconfigdat)
		    (if mtcachef (configf:write-alist *configdat* mtcachef))
		    (if (and rccachef mtcachef) (set! *configstatus* 'fulldata))))
		;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table
		(if exit-if-non-megatest-area  ;; second pass, exit or set configdat to dummy hashtable
		    (exit 1)
		    (set! *configdat* (make-hash-table))))))



	 ;; else read what you can and set the flag accordingly
	 (else
          ;;(BB> "launch:setup-body -- cond branch 3 - else")
	  (let* ((cfgdat   (find-and-read-config 
			    (or (args:get-arg "-config") "megatest.config")
			    environ-patt: "env-override"
			    given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
974
975
976
977
978
979
980
981

982
983
984
985
986
987
988
989
990
991
992
993
994
995
996





997
998
999
1000
1001
1002
1003
	    (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.")
	      ;;(exit 1)
	      (set! *toppath* #f) ;; force it to be false so we return #f
	      #f

	      ))
        ;; one more attempt to cache the configs for future reading
        (let* ((cachefiles   (launch:get-cache-file-paths areapath toppath target mtconfig))
               (mtcachef     (car cachefiles))
               (rccachef     (cdr cachefiles)))
          (if (and rccachef *runconfigdat*) (configf:write-alist *runconfigdat* rccachef))
          (if (and mtcachef *configdat*)    (configf:write-alist *configdat* mtcachef))
          (if (and rccachef mtcachef *runconfigdat* *configdat*)
              (set! *configstatus* 'fulldata)))

	;; if have -append-config then read and append here
	(let ((cfname (args:get-arg "-append-config")))
	  (if (and cfname
		   (file-read-access? cfname))
	      (read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special.





	*toppath*)))

(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))







|
>
|














>
>
>
>
>







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
	    (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.")
	      ;;(exit 1)
	      (set! *toppath* #f) ;; force it to be false so we return #f
	      (if exit-if-non-megatest-area
		  (exit 1)
		  #f)))
        ;; one more attempt to cache the configs for future reading
        (let* ((cachefiles   (launch:get-cache-file-paths areapath toppath target mtconfig))
               (mtcachef     (car cachefiles))
               (rccachef     (cdr cachefiles)))
          (if (and rccachef *runconfigdat*) (configf:write-alist *runconfigdat* rccachef))
          (if (and mtcachef *configdat*)    (configf:write-alist *configdat* mtcachef))
          (if (and rccachef mtcachef *runconfigdat* *configdat*)
              (set! *configstatus* 'fulldata)))

	;; if have -append-config then read and append here
	(let ((cfname (args:get-arg "-append-config")))
	  (if (and cfname
		   (file-read-access? cfname))
	      (read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special.
	(if (and (not *toppath*)
		 exit-if-non-megatest-area)
	    (begin
	      (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")
	      (exit 1)))
	*toppath*)))

(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))