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

    (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)

		 (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)))




					     (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







|
>





|
>
>
>
>







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)
		 (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))
					       (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