Megatest

Check-in [8e05d02c79]
Login
Overview
Comment:Get numbers from the configs using protected call with default
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 8e05d02c79e9478a6b830fcc4d437ab9a7a4a984
User & Date: mrwellan on 2017-05-15 17:41:18
Other Links: branch diff | manifest | tags
Context
2017-05-15
18:01
Merged removal of synchash to v1.64 as it passes all tests check-in: 334691e890 user: mrwellan tags: v1.64
17:41
Get numbers from the configs using protected call with default check-in: 8e05d02c79 user: mrwellan tags: v1.64
2017-05-12
17:49
bump version check-in: 554fc3a386 user: bjbarcla tags: v1.64, v1.6413
Changes

Modified configf.scm from [035be18ade] to [23b5854111].

423
424
425
426
427
428
429













430
431
432
433
434
435
436
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449







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







		  (cadr match)
		  #f))
	    ))
      #f))

(define configf:lookup config-lookup)
(define configf:read-file read-config)

;; safely look up a value that is expected to be a number, return
;; a default (#f unless provided)
;;
(define (configf:lookup-number cfdat section varname #!key (default #f))
  (let* ((val (configf:lookup *configdat* section varname))
         (res (if val
                  (string->number (string-substitute "\\s+" "" val #t))
                  #f)))
    (cond
     (res  res)
     (val  (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
     (else default))))

(define (configf:section-vars cfgdat section)
  (let ((sectdat (hash-table-ref/default cfgdat section '())))
    (if (null? sectdat)
	'()
	(map car sectdat))))

Modified launch.scm from [12386485fd] to [d6685cb69b].

1204
1205
1206
1207
1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1204
1205
1206
1207
1208
1209
1210

1211
1212
1213
1214
1215
1216
1217
1218







-
+







;;    - could be netbatch
;;      (launch-test db (cadr status) test-conf))
(define (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params)
  (mutex-lock! *launch-setup-mutex*) ;; setting variables and processing the testconfig is NOT thread-safe, reuse the launch-setup mutex
  (let* ((item-path       (item-list->path itemdat))
	 (contour         #f)) ;; NOT READY FOR THIS (args:get-arg "-contour")))
    (let loop ((delta        (- (current-seconds) *last-launch*))
	       (launch-delay (string->number (or (configf:lookup *configdat* "setup" "launch-delay") "0"))))
	       (launch-delay (configf:lookup-number *configdat* "setup" "launch-delay" default: 1)))
      (if (> launch-delay delta)
	  (begin
	    (debug:print-info 0 *default-log-port* "Delaying launch of " test-name " for " (- launch-delay delta) " seconds")
	    (thread-sleep! (- launch-delay delta))
	    (loop (- (current-seconds) *last-launch*) launch-delay))))
    (change-directory *toppath*)
    (alist->env-vars ;; consolidate this code with the code in megatest.scm for "-execute", *maybe* - the longer they are set the longer each launch takes (must be non-overlapping with the vars)

Modified runs.scm from [c727da7e38] to [cd7537ebe8].

1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1160
1161
1162
1163
1164
1165
1166

1167




1168
1169
1170
1171
1172
1173
1174
1175







-
+
-
-
-
-
+







  (let* ((run-info             (rmt:get-run-info run-id))
	(tests-info            (mt:get-tests-for-run run-id #f '() '())) ;;  qryvals: "id,testname,item_path"))
	(sorted-test-names     (tests:sort-by-priority-and-waiton test-records))
	(test-registry         (make-hash-table))
	(registry-mutex        (make-mutex))
	(num-retries           0)
	(max-retries           (config-lookup *configdat* "setup" "maxretries"))
	(max-concurrent-jobs   (let ((mcj (config-lookup *configdat* "setup"     "max_concurrent_jobs")))
	(max-concurrent-jobs   (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
				 (if (and mcj (string->number mcj))
				     (string->number mcj)
				     1))) ;; length of the register queue ahead
	(reglen                (if (number? reglen-in) reglen-in 1))
        (reglen                (if (number? reglen-in) reglen-in 1))
	(last-time-incomplete  (- (current-seconds) 900)) ;; force at least one clean up cycle
	(last-time-some-running (current-seconds))
	;; (tdbdat                (tasks:open-db))
	(runsdat (make-runs:dat
		  ;; hed: hed
		  ;; tal: tal
		  ;; reg: reg