Overview
Comment: | filled out more exception handlers. ==/3.73/1.3/PASS/1203/orion/== |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-cleanup |
Files: | files | file ages | folders |
SHA1: |
1cf9221da58afe7bffd32e504f08d69f |
User & Date: | mrwellan on 2020-08-24 06:54:26 |
Original Comment: | filled out more exception handlers. |
Other Links: | branch diff | manifest | tags |
Context
2020-08-24
| ||
18:06 | Saftey fixes and minor cleanup ==/3.73/1.3/PASS/1203/orion/== check-in: 79674abc64 user: mrwellan tags: v1.65-cleanup | |
06:54 | filled out more exception handlers. ==/3.73/1.3/PASS/1203/orion/== check-in: 1cf9221da5 user: mrwellan tags: v1.65-cleanup | |
00:23 | Added more granular exception handling ==/9.4/0.9/WARN/2102/mars/== ==/5.7/1.2/WARN/1201/mars/== check-in: 0f33ea4295 user: mrwellan tags: v1.65-cleanup | |
Changes
Modified common_records.scm from [72d272b34e] to [f00d4d5706].
︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | + | ((_ (name arg ...) body ...) (define-syntax name (syntax-rules () ((name arg ...) (begin body ...))))))) ;; (define-syntax common:handle-exceptions ;; (syntax-rules () ;; ((_ exn-in errstmt ...)(handle-exceptions exn-in errstmt ...)))) ;; this works, why didn't I use it more? (define-syntax common:debug-handle-exceptions (syntax-rules () ((_ debug exn errstmt body ...) (if debug (begin body ...) (handle-exceptions exn errstmt body ...))))) |
︙ |
Modified megatest.scm from [71d98ab132] to [c469764f4f].
︙ | |||
496 497 498 499 500 501 502 | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | - + | ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (define *watchdog* (make-thread (lambda () (handle-exceptions exn (begin (print-call-chain) |
︙ | |||
550 551 552 553 554 555 556 | 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 | - + | ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation ;; where (launch:setup) returns #f? ;; (if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server (handle-exceptions exn (begin |
︙ | |||
600 601 602 603 604 605 606 | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 | - - + + + + | (let ((original-exit (exit-handler))) (exit-handler (lambda (#!optional (exit-code 0)) (printf "Preparing to exit with exit code ~A ...\n" exit-code) (for-each (lambda (pid) (handle-exceptions |
︙ |
Modified mt.scm from [6bcd02e8ac] to [e9055c2687].
︙ | |||
188 189 190 191 192 193 194 | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | - + | (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) ;; (mutex-lock! *triggers-mutex*) (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* " Exception in mt:process-triggers for run-id="run-id" test-id="test-id" newstate="newstate" newstatus="newstatus |
︙ |
Modified process.scm from [b12ad1bbce] to [f9dfbe5500].
︙ | |||
194 195 196 197 198 199 200 | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | - - + + + + | (let-values (((rpid exit-type exit-signal)(process-wait pid #t))) (and (number? rpid) (equal? rpid pid))))) (define (process:alive-on-host? host pid) (let ((cmd (conc "ssh " host " ps -o pid= -p " pid))) (handle-exceptions |
︙ |
Modified rmt.scm from [f016ee8609] to [f699e4c73f].
︙ | |||
413 414 415 416 417 418 419 | 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | - - - + + + + + | / (set! *db-last-access* start-time) ;; THIS IS PROBABLY USELESS? (we are on a client) (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) (res (handle-exceptions |
︙ |
Modified server.scm from [3e4e26900f] to [bafb54f0c9].
︙ | |||
166 167 168 169 170 171 172 | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | + + - + | ;; given a path to a server log return: host port startseconds ;; (define (server:logf-get-start-info logf) (let ((rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+)"))) ;; SERVER STARTED: host:port AT timesecs (handle-exceptions exn (begin (print "failed to get server info from " logf ", exn=" exn) |
︙ | |||
212 213 214 215 216 217 218 | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 | + + - + | (if (null? server-logs) '() (let loop ((hed (car server-logs)) (tal (cdr server-logs)) (res '())) (let* ((mod-time (handle-exceptions exn (begin (print "failed to get modification time on " hed ", exn=" exn) |
︙ |
Modified tasks.scm from [dcc03dba77] to [b621e9649f].
︙ | |||
71 72 73 74 75 76 77 | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | - + | (define (tasks:get-task-db-path) (let ((dbdir (or (configf:lookup *configdat* "setup" "monitordir") (configf:lookup *configdat* "setup" "dbdir") (conc (common:get-linktree) "/.db")))) (handle-exceptions exn (begin |
︙ |
Modified tests.scm from [947715acf0] to [0094b671e6].
︙ | |||
550 551 552 553 554 555 556 | 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | + + - + | (change-directory orig-dir) ;; NB// tests:test-set-toplog! is remote internal... (tests:test-set-toplog! run-id test-name outputfilename)) ;; didn't get the lock, check to see if current update started later than this ;; update, if so we can exit without doing any work (if (> my-start-time (handle-exceptions exn (begin (print "failed to get mod time on " lockf ", exn=" exn) |
︙ | |||
1502 1503 1504 1505 1506 1507 1508 1509 | 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 | + + - - + + | (if fnamepatt (apply append (map (lambda (p) (if (directory-exists? p) (let ((glob-query (conc p "/" fnamepatt))) (handle-exceptions exn (begin (print "built-in glob on " glob-query ", failed, try using the shell. exn=" exn) (with-input-from-pipe |
︙ | |||
1557 1558 1559 1560 1561 1562 1563 | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 | - - - + + + + + | (cache-exists (and cache-file (not force-create) ;; if force-create then pretend there is no cache to read (common:file-exists? cache-file))) (cached-dat (if (and (not force-create) cache-exists use-cache) (handle-exceptions |
︙ |