Overview
Comment: | Added stop-the-train, crowbar switch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70 |
Files: | files | file ages | folders |
SHA1: |
bf4367276064e2920c46982263af598e |
User & Date: | matt on 2022-11-08 22:15:13 |
Other Links: | branch diff | manifest | tags |
Context
2022-11-10
| ||
13:37 | Fixed server/client signature. I think. check-in: bf877ecde8 user: matt tags: v1.70 | |
2022-11-08
| ||
22:15 | Added stop-the-train, crowbar switch check-in: bf43672760 user: matt tags: v1.70 | |
14:24 | Added improved new to old converter check-in: 5458437545 user: mrwellan tags: v1.70 | |
Changes
Modified common.scm from [8e93110015] to [7a004393e6].
︙ | ︙ | |||
40 41 42 43 44 45 46 47 48 49 50 51 52 53 | ;; (define old-exit exit) ;; ;; (define (exit . code) ;; (if (null? code) ;; (old-exit) ;; (old-exit code))) ;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* . ;; arguments - thunk, message (define (common:fail-safe thunk warning-message-on-exception) (handle-exceptions exn (begin | > > > > > > > > > > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | ;; (define old-exit exit) ;; ;; (define (exit . code) ;; (if (null? code) ;; (old-exit) ;; (old-exit code))) (define (stop-the-train) (thread-start! (make-thread (lambda () (let loop () (if (and *toppath* (file-exists? (conc *toppath*"/stop-the-train"))) (begin (debug:print 0 *default-log-port* "ERROR: found file "*toppath*"/stop-the-train, exiting immediately") (exit 1))) (thread-sleep! 5) (loop)))))) ;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* . ;; arguments - thunk, message (define (common:fail-safe thunk warning-message-on-exception) (handle-exceptions exn (begin |
︙ | ︙ |
Modified commonmod.scm from [79bf78cc96] to [2570fcf4eb].
︙ | ︙ | |||
206 207 208 209 210 211 212 213 214 215 216 217 218 219 | ;; (define (get-cfg-areas cfgdat) (let ((adat (get-section cfgdat "areas"))) (map (lambda (entry) `(,(car entry) . ,(val->alist (cadr entry)))) adat))) ;; (define (debug:print . params) #f) ;; (define (debug:print-info . params) #f) ;; ;; (define (set-functions dbgp dbgpinfo) ;; (set! debug:print dbgp) ;; (set! debug:print-info dbgpinfo)) | > > > > | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | ;; (define (get-cfg-areas cfgdat) (let ((adat (get-section cfgdat "areas"))) (map (lambda (entry) `(,(car entry) . ,(val->alist (cadr entry)))) adat))) ;;====================================================================== ;; misc stuff ;;====================================================================== ;; (define (debug:print . params) #f) ;; (define (debug:print-info . params) #f) ;; ;; (define (set-functions dbgp dbgpinfo) ;; (set! debug:print dbgp) ;; (set! debug:print-info dbgpinfo)) |
︙ | ︙ |
Modified dashboard.scm from [124f6f1518] to [6283f67b19].
︙ | ︙ | |||
3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 | (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) )) "dashboard:runs-tab-updater")) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== (define (main) ;; (print "Starting dashboard main") (let* ((mtdb-path (conc *toppath* "/.megatest/main.db")) (target (args:get-arg "-target")) (commondat (dboard:commondat-make))) | > | 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 | (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) )) "dashboard:runs-tab-updater")) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== (stop-the-train) (define (main) ;; (print "Starting dashboard main") (let* ((mtdb-path (conc *toppath* "/.megatest/main.db")) (target (args:get-arg "-target")) (commondat (dboard:commondat-make))) |
︙ | ︙ |
Modified dbfile.scm from [2d10dcee17] to [5fcb8e6b81].
︙ | ︙ | |||
329 330 331 332 333 334 335 | (define (dbfile:print-err . params) (with-output-to-port (current-error-port) (lambda () (apply print params)))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | (define (dbfile:print-err . params) (with-output-to-port (current-error-port) (lambda () (apply print params)))) (define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500)) (let* ((busy-file (conc fname"-journal")) (delay-time (* (- 51 tries-left) 1.1)) (write-access (file-write-access? fname)) (dir-access (file-write-access? (pathname-directory fname))) (retry (lambda () |
︙ | ︙ | |||
545 546 547 548 549 550 551 | (let* ((backupfname (conc fname"-"(current-process-id)".bak")) (cmd (conc "cp "fname" "backupfname";mv "fname" "(conc fname ".delme;") "cp "backupfname" "fname))) (dbfile:print-err "WARNING: attempting recovery of file "fname" by running commands:\n" " "cmd) (system cmd))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 | (let* ((backupfname (conc fname"-"(current-process-id)".bak")) (cmd (conc "cp "fname" "backupfname";mv "fname" "(conc fname ".delme;") "cp "backupfname" "fname))) (dbfile:print-err "WARNING: attempting recovery of file "fname" by running commands:\n" " "cmd) (system cmd))) (define (dbfile:open-no-sync-db dbpath) (if *no-sync-db* *no-sync-db* (begin (if (not (file-exists? dbpath)) (create-directory dbpath #t)) |
︙ | ︙ |
Modified launch.scm from [8b5c3e3658] to [60d380c61b].
︙ | ︙ | |||
914 915 916 917 918 919 920 921 922 923 924 925 926 927 | ;; side effects: ;; sets; *configdat* (megatest.config info) ;; *runconfigdat* (runconfigs.config info) ;; *configstatus* (status of the read data) ;; (define (launch:setup #!key (force-reread #f) (areapath #f)) (mutex-lock! *launch-setup-mutex*) (if (and *toppath* (eq? *configstatus* 'fulldata) (not force-reread)) ;; got it all (begin (debug:print 2 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata") (mutex-unlock! *launch-setup-mutex*) *toppath*) (let ((res (launch:setup-body force-reread: force-reread areapath: areapath))) | > > > > > > | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 | ;; side effects: ;; sets; *configdat* (megatest.config info) ;; *runconfigdat* (runconfigs.config info) ;; *configstatus* (status of the read data) ;; (define (launch:setup #!key (force-reread #f) (areapath #f)) (mutex-lock! *launch-setup-mutex*) ;; this stops the train quickly for new processes (if (and *toppath* (file-exists? (conc *toppath*"/stop-the-train"))) (begin (debug:print 0 *default-log-port* "ERROR: found file "*toppath*"/stop-the-train, exiting immediately") (exit 1))) (if (and *toppath* (eq? *configstatus* 'fulldata) (not force-reread)) ;; got it all (begin (debug:print 2 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata") (mutex-unlock! *launch-setup-mutex*) *toppath*) (let ((res (launch:setup-body force-reread: force-reread areapath: areapath))) |
︙ | ︙ |
Modified megatest.scm from [92b16ace59] to [7c70251ef1].
︙ | ︙ | |||
555 556 557 558 559 560 561 562 563 564 565 566 567 568 | (start-watchdog (and (null? no-watchdog-args-vals) start-watchdog-specail-arg-val))) ;(print "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals " start-watchdog-specail-arg-val:" start-watchdog-specail-arg-val " start-watchdog:" start-watchdog) ;; (if start-watchdog ;; (thread-start! *watchdog*)) #t ) ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions (define (open-logfile logpath-in) (condition-case (let* ((log-dir (or (pathname-directory logpath-in) ".")) (fname (pathname-strip-directory logpath-in)) (logpath (if (> (string-length fname) 250) | > > | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 | (start-watchdog (and (null? no-watchdog-args-vals) start-watchdog-specail-arg-val))) ;(print "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals " start-watchdog-specail-arg-val:" start-watchdog-specail-arg-val " start-watchdog:" start-watchdog) ;; (if start-watchdog ;; (thread-start! *watchdog*)) #t ) ;; stop the train watchdog (stop-the-train) ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions (define (open-logfile logpath-in) (condition-case (let* ((log-dir (or (pathname-directory logpath-in) ".")) (fname (pathname-strip-directory logpath-in)) (logpath (if (> (string-length fname) 250) |
︙ | ︙ |