Megatest

Check-in [dd35c27850]
Login
Overview
Comment:Cleaned up testconfig caching
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60_defunct
Files: files | file ages | folders
SHA1: dd35c27850f5a99139a26e787db475e624c75c6a
User & Date: matt on 2016-03-07 22:41:37
Other Links: branch diff | manifest | tags
Context
2016-03-07
23:21
Some streamlining of runconfigs handling check-in: d27d605394 user: matt tags: v1.60_defunct
22:41
Cleaned up testconfig caching check-in: dd35c27850 user: matt tags: v1.60_defunct
08:36
Fix couple misnamed calls check-in: c3569862dc user: mrwellan tags: v1.60_defunct
Changes

Modified tests.scm from [d26f89ce12] to [d8f0eca904].

733
734
735
736
737
738
739





740



















741
742
743
744

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762


763
764

765

766

767
768

769
770
771
772
773
774

775
776
777
778
779
780
781
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766


767
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







+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+



-
-
-
-
-

-
-
-
-
-
-
-
-
-
+
+

-
+

+
-
+

-
+
-




-
+







	     (getenv "MT_TARGET")    "/"
	     (getenv "MT_RUNNAME")   "/"
	     (getenv "MT_TEST_NAME") "/"
	     (if (or (getenv "MT_ITEMPATH")
		     (not (string=? "" (getenv "MT_ITEMPATH"))))
		 (conc "/" (getenv "MT_ITEMPATH"))))))

;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;;   if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
  (let* ((cache-path   (tests:get-test-path-from-environment))
	 (cache-file   (and cache-path (conc cache-path "/.testconfig")))
	 (cache-exists (and cache-file
			    (not force-create)  ;; if force-create then pretend there is no cache to read
			    (file-exists? cache-file)))
	 (cached-dat   (if (and (not force-create)
				cache-exists)
			   (handle-exceptions
			    exn
			    #f ;; any issues, just give up with the cached version and re-read
			    (configf:read-alist cache-file))
			   #f)))
    (if cached-dat
	cached-dat
	(let ((dat (hash-table-ref/default *testconfigs* test-name #f)))
	  (if (and  dat ;; have a locally cached version
		    (hash-table-ref/default dat "have fulldata" #f)) ;; marked as good data?
	      dat
	      ;; no cached data available
  (let* ((treg              (or test-registry
				(tests:get-all)))
	 (test-path         (hash-table-ref/default 
			     treg test-name 
		     (test-path    (or (hash-table-ref/default treg test-name #f)
			     (conc *toppath* "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (cache-path   (tests:get-test-path-from-environment))
	 (cache-exists (and cache-path 
			    (not force-create)  ;; if force-create then pretend there is no cache to read
			    (file-exists? (conc cache-path "/.testconfig"))))
	 (cache-file   (conc cache-path "/.testconfig"))
	 (tcfg         (if testexists
			   (or (and (not force-create)
				    cache-exists
				    (handle-exceptions
				     exn
				     (begin
				       (debug:print 0 "WARNING: Failed to read " cache-file) 
				       (make-hash-table)) ;; better to return a hash and keep going - I think
				     (configf:read-alist cache-file)))
			       (read-config test-configf #f system-allowed environ-patt: (if system-allowed
				       (read-config test-configf #f system-allowed
						    environ-patt: (if system-allowed
											     "pre-launch-env-vars"
											     #f)))
								      #f))
			   #f)))
		(if cache-file (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
    (hash-table-set! *testconfigs* test-name tcfg)
		(if tcfg (hash-table-set! *testconfigs* test-name tcfg))
    (if (and testexists
	     cache-path
			 cache-file
	     (not cache-exists)
	     (file-write-access? cache-path))
	(let ((tpath (conc cache-path "/.testconfig")))
	  (debug:print-info 1 "Caching testconfig for " test-name " in " tpath)
	  (configf:write-alist tcfg tpath)))
    tcfg))
		tcfg))))))
  
;; sort tests by priority and waiton
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-records)
  (let* ((mungepriority (lambda (priority)
			  (if priority
			      (let ((tmp (any->number priority)))