Megatest

Diff
Login

Differences From Artifact [1d514c355f]:

To Artifact [bc68bfb44c]:


1236
1237
1238
1239
1240
1241
1242













1243

1244
1245
1246
1247
1248
1249
1250
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255

1256
1257
1258
1259
1260
1261
1262
1263







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







;; 3. create link from run dir to megatest runs area 
;; 4. remotely run the test on allocated host
;;    - could be ssh to host from hosts table (update regularly with load)
;;    - 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* ((lock-key        (conc "test-" test-id))
	 (got-lock        (let loop ((lock        (rmt:no-sync-get-lock lock-key))
				     (expire-time (+ (current-seconds) 15))) ;; give up on getting the lock and steal it after 15 seconds
			    (if (car lock)
				#t
				(if (> (current-seconds) expire-time)
				    (begin
				      (debug:print-info 0 *default-log-port* "Timed out waiting for a lock to launch test " keyvals " " runname " " test-name " " test-path)
				      (rmt:no-sync-del! lock-key) ;; destroy the lock
				      (loop (rmt:no-sync-get-lock lock-key) expire-time)) ;; 
				    (begin
				      (thread-sleep! 1)
				      (loop (rmt:no-sync-get-lock lock-key) expire-time))))))
  (let* ((item-path       (item-list->path itemdat))
	 (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 (configf:lookup-number *configdat* "setup" "launch-delay" default: 1)))
      (if (> launch-delay delta)
	  (begin
	    (if (common:low-noise-print 1200 "test launch delay") ;; every two hours or so remind the user about launch delay.
		(debug:print-info 0 *default-log-port* "NOTE: test launches are delayed by " launch-delay " seconds. See megatest.config launch-delay setting to adjust.")) ;; launch of " test-name " for " (- launch-delay delta) " seconds"))
1412
1413
1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439







+







					      cmdstr
					      (conc cmdstr " >> mt_launch.log 2>&1 &")))
					(car fullcmd))
				    (if useshell
					'()
					(cdr fullcmd)))))
        (mutex-unlock! *launch-setup-mutex*) ;; yes, really should mutex all the way to here. Need to put this entire process into a fork.
	(rmt:no-sync-del! lock-key)         ;; release the lock for starting this test
	(if (not launchwait) ;; give the OS a little time to allow the process to start
	    (thread-sleep! 0.01))
	(with-output-to-file "mt_launch.log"
	  (lambda ()
	    (print "LAUNCHCMD: " (string-intersperse fullcmd " "))
	    (if (list? launch-results)
		(apply print launch-results)