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
	     (getenv "MT_TARGET")    "/"
	     (getenv "MT_RUNNAME")   "/"
	     (getenv "MT_TEST_NAME") "/"
	     (if (or (getenv "MT_ITEMPATH")
		     (not (string=? "" (getenv "MT_ITEMPATH"))))
		 (conc "/" (getenv "MT_ITEMPATH"))))))






(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
  (let* ((treg              (or test-registry
				(tests:get-all)))
	 (test-path         (hash-table-ref/default 
			     treg test-name 
			     (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

											     "pre-launch-env-vars"
											     #f)))
			   #f)))

    (hash-table-set! *testconfigs* test-name tcfg)
    (if (and testexists
	     cache-path
	     (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))
  
;; 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)))







>
>
>
>
>

<
<
<
<
<
<
<
|
>
|

|
<
<
|
|
|
|
<
<
<
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
>
|
|
|
<
|
|
|
|
|







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    (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)))
		     (tcfg         (if testexists
				       (read-config test-configf #f system-allowed
						    environ-patt: (if system-allowed
								      "pre-launch-env-vars"
								      #f))
				       #f)))
		(if cache-file (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
		(if tcfg (hash-table-set! *testconfigs* test-name tcfg))
		(if (and testexists
			 cache-file

			 (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))))))
  
;; 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)))