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: |
e2b30e322b4c00604681afc592776813 |
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 | (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) | | | 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) ;; (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 | ;; 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 () | > | | | | | | | | | | | 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))) "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 |
︙ | ︙ |