Megatest

Diff
Login

Differences From Artifact [eec26c4ab2]:

To Artifact [82f5f9277a]:


1515
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
1529







-
+







      #f))

;; 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 item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t))
(define (tests:get-testconfig test-name item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t)(wait-a-minute #f))
  (let* ((use-cache    (common:use-cache?))
	 (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
			    (common:file-exists? cache-file)))
	 (cached-dat   (if (and (not force-create)
1545
1546
1547
1548
1549
1550
1551


1552











1553
1554
1555
1556
1557
1558
1559
1545
1546
1547
1548
1549
1550
1551
1552
1553

1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571







+
+
-
+
+
+
+
+
+
+
+
+
+
+







	      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 (let loop ((tries-left 7))
                                   (cond
		     (testexists   (and (common:file-exists? test-configf)(file-read-access? test-configf)))
                                    ( (and (common:file-exists? test-configf)(file-read-access? test-configf))
                                      #t)
                                    ( (common:file-exists? test-configf)
                                      (debug:print 0 *default-log-port* "WARNING: Cannot read testconfig file: "test-configf)
                                      #f)
                                    ( (and wait-a-minute (> tries-left 0))
                                      (thread-sleep! 10)
                                      (loop (sub1 tries-left)))
                                    (else
                                     (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf)
                                     #f))))
		     (tcfg         (if testexists
				       (read-config test-configf #f system-allowed
						    environ-patt: (if system-allowed
								      "pre-launch-env-vars"
								      #f))
				       #f)))
		(if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data