Megatest

Check-in [3ccc64251f]
Login
Overview
Comment:Partial fix for #{shell ...} problem in testconfigs
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-shell-problem | v1.65-broken
Files: files | file ages | folders
SHA1: 3ccc64251fcfc210fe7ba1998fa90a96d3bf2fa3
User & Date: mrwellan on 2020-04-30 22:44:51
Other Links: branch diff | manifest | tags
Context
2020-05-01
15:58
Upped allowed time for reading cached load data to 10 sec. The load is over a 60 sec. window, does 10 seconds really make a difference? check-in: 6625f3bc6a user: mrwellan tags: v1.65-shell-problem, v1.65-broken
2020-04-30
22:44
Partial fix for #{shell ...} problem in testconfigs check-in: 3ccc64251f user: mrwellan tags: v1.65-shell-problem, v1.65-broken
16:22
rewrite absurdly long log file names if over 250 chars long check-in: 0a9e690b28 user: mrwellan tags: v1.65-broken
Changes

Modified tests.scm from [bf1af44b82] to [fbd7ebda22].

166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180







-
+







      (items:get-items-from-config tconfig))
     (else #f))))                           ;; not iterated


;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
   (let* ((config  (tests:get-testconfig test-name #f all-tests-registry 'return-procs))) ;; assuming no problems with immediate evaluation, this could be simplified ('return-procs -> #t)
   (let* ((config  (tests:get-testconfig test-name #f all-tests-registry #t))) ;;'return-procs))) ;; assuming no problems with immediate evaluation, this could be simplified ('return-procs -> #t)
     (let ((instr (if config 
		      (configf:lookup config "requirements" "waiton")
		      (begin ;; No config means this is a non-existant test
			(debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"")
			(exit 1))))
	   (instr2 (if config
		       (configf:lookup config "requirements" "waitor")
1577
1578
1579
1580
1581
1582
1583


1584


1585
1586
1587
1588
1589

1590
1591
1592

1593
1594
1595
1596

1597
1598


1599
1600
1601
1602
1603
1604

1605
1606
1607
1608
1609
1610
1611
1577
1578
1579
1580
1581
1582
1583
1584
1585

1586
1587
1588
1589
1590


1591
1592


1593
1594
1595


1596
1597

1598
1599
1600
1601
1602
1603
1604

1605
1606
1607
1608
1609
1610
1611
1612







+
+
-
+
+



-
-
+

-
-
+


-
-
+

-
+
+





-
+







                                                                 (getenv "MT_TARGET") "/"
                                                                 (getenv "MT_RUNNAME") "/"
                                                                 test-name "/" item-path))
                                              (local-tcfg (conc local-tcdir "/testconfig")))
                                         (if (common:file-exists? local-tcfg)
                                             local-tcdir
                                             #f))
				       (begin
					 (debug:print-info 0 *default-log-port* "reading testconfig for "test-full-name" from tests/"test-name" directory.")
				       (conc *toppath* "/tests/" test-name)))
					 (conc *toppath* "/tests/" test-name)) ;; should this fallback exist?
				       ))
		     (test-configf (conc test-path "/testconfig"))
		     (testexists   (let loopa ((tries-left 30))
                                     (cond
                                      (
                                       (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)
                                      ((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))
                                      ((and wait-a-minute (> tries-left 0))
                                       (thread-sleep! 10)
                                       (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf" will retry in 10 seconds.  Tries left: "tries-left) ;; BB: this fires
                                       (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf
						    " will retry in 10 seconds.  Tries left: "tries-left) ;; BB: this fires
                                       (loopa (sub1 tries-left)))
                                      (else
                                       (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
                                       #f))))
		     (tcfg         (if testexists
				       (read-config test-configf #f system-allowed
				       (configf:read-file 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
		(if tcfg (hash-table-set! *testconfigs* test-full-name tcfg))
		(if (and testexists