Megatest

Check-in [187be74df3]
Login
Overview
Comment:Allow some retries on run queue processing if server died (temporary work-around until the recovery is coded correctly)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 187be74df3abd6e32463eb35fc521ba21564db3a
User & Date: mrwellan on 2014-12-09 09:38:36
Other Links: branch diff | manifest | tags
Context
2014-12-09
10:27
Treat any exceptions when logging into server as a dead server (for now) check-in: 19f6ae918c user: mrwellan tags: v1.60
09:38
Allow some retries on run queue processing if server died (temporary work-around until the recovery is coded correctly) check-in: 187be74df3 user: mrwellan tags: v1.60
09:29
Unlock communication mutex on recoverable crash. Return #f when communication fails, not (vector #f stuff ...) check-in: d5009e9f15 user: mrwellan tags: v1.60
Changes

Modified runs.scm from [52961e3bf4] to [fb0ddf9858].

365
366
367
368
369
370
371
372


373
374
375
376
377
378





379
380
381
382
383
384
385
365
366
367
368
369
370
371

372
373
374
375
376
377
378

379
380
381
382
383
384
385
386
387
388
389
390







-
+
+





-
+
+
+
+
+








    (if (not (null? required-tests))
	(debug:print-info 1 "Adding " required-tests " to the run queue"))
    ;; NOTE: these are all parent tests, items are not expanded yet.
    (debug:print-info 4 "test-records=" (hash-table->alist test-records))
    (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
      (if (> (length (hash-table-keys test-records)) 0)
	  (let* ((keep-going #t)
	  (let* ((keep-going        #t)
		 (run-queue-retries 5)
		 (th1        (make-thread (lambda ()
					    (handle-exceptions
					     exn
					     (begin
					       (print-call-chain (current-error-port))
					       (debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn)))
					       (debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn))
					       (if (> run-queue-retries 0)
						   (begin
						     (set! run-queue-retries (- run-queue-retries 1))
						     (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))))
					     (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry)))
					  "runs:run-tests-queue"))
		 (th2        (make-thread (lambda ()				    
					    ;; (rmt:find-and-mark-incomplete-all-runs))))) CAN'T INTERRUPT IT ...
					    (let ((run-ids (rmt:get-all-run-ids)))
					      (for-each (lambda (run-id)
							  (if keep-going