Megatest

Check-in [e2b30e322b]
Login
Overview
Comment:Disabled useless exception handler and corrected typo
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: e2b30e322b4c00604681afc59277681386392e48
User & Date: matt on 2016-05-07 22:27:16
Other Links: branch diff | manifest | tags
Context
2016-05-08
17:38
Added hash to version on -version. check-in: 5069be9015 user: matt tags: v1.61
2016-05-07
22:27
Disabled useless exception handler and corrected typo check-in: e2b30e322b user: matt tags: v1.61
15:30
Fixed couple minor bugs introduced by depending on version signature check-in: 8555536d88 user: matt tags: v1.61
Changes

Modified runs.scm from [301a2c24cc] to [cd4112308f].

193
194
195
196
197
198
199
200

201
202
203
204
205
206
207
193
194
195
196
197
198
199

200
201
202
203
204
205
206
207







-
+







    (if (and config-reruns
	     (> run-count config-reruns))
	(set! run-count config-reruns))
    
    (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))

    (let ((sighand (lambda (signum)
		    y ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
		     ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
		     (set! *time-to-exit* #t)
		     (print "Received signal " signum ", cleaning up before exit. Please wait...")
		     (let ((th1 (make-thread (lambda ()
					       (let ((tdbdat (tasks:open-db)))
						 (rmt:tasks-set-state-given-param-key task-key "killed"))
					       (print "Killed by signal " signum ". Exiting")
					       (thread-sleep! 3)
371
372
373
374
375
376
377

378
379
380
381
382
383
384
385
386
387










388
389
390
391
392
393
394
371
372
373
374
375
376
377
378










379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395







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







    ;; 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 ()
					    (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))
					    (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)))
					    ;; (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
							      (handle-exceptions