Overview
Comment: | Default to tcp in dashboard. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
d8806806d573da5f818b3288cd647256 |
User & Date: | matt on 2023-08-21 17:15:26 |
Other Links: | branch diff | manifest | tags |
Context
2023-09-29
| ||
08:07 | Added beginnings of processes table in no-sync check-in: 923cf91611 user: matt tags: v1.80-processes | |
2023-08-21
| ||
17:44 | merged fork check-in: f5b6549716 user: mmgraham tags: v1.80, v1.8017 | |
17:15 | Default to tcp in dashboard. check-in: d8806806d5 user: matt tags: v1.80 | |
10:29 | Changed servers to be run under system instead of nbfake to help batch tools detect that the process is still running (untested). check-in: 4fe087efa3 user: matt tags: v1.80 | |
Changes
Modified common.scm from [00402a6248] to [516effd7ae].
︙ | ︙ | |||
931 932 933 934 935 936 937 | (if (equal? thepath "/") (begin (debug:print-error 0 *default-log-port* "Unable to find megatest home directory.") #f) (loop (pathname-directory thepath))))) )) | < < < < < < < < < < < | 931 932 933 934 935 936 937 938 939 940 941 942 943 944 | (if (equal? thepath "/") (begin (debug:print-error 0 *default-log-port* "Unable to find megatest home directory.") #f) (loop (pathname-directory thepath))))) )) ;;====================================================================== ;; redefine for future cleanup (converge on area-name, the more generic ;; (define common:get-area-name common:get-testsuite-name) (define (common:get-db-tmp-area . junk) |
︙ | ︙ | |||
965 966 967 968 969 970 971 | (tsname (common:get-testsuite-name)) (dbpath (common:get-create-writeable-dir (list (conc "/tmp/" (current-user-name) "/megatest_localdb/" tsname "/" (string-translate toppath "/" ".")) (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name | | | 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 | (tsname (common:get-testsuite-name)) (dbpath (common:get-create-writeable-dir (list (conc "/tmp/" (current-user-name) "/megatest_localdb/" tsname "/" (string-translate toppath "/" ".")) (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name "/"(current-user-name) "/megatest_localdb/" tsname (string-translate toppath "/" ".")) )))) (set! *db-cache-path* dbpath) ;; ensure megatest area has .mtdb (let ((dbarea (conc *toppath* "/.mtdb"))) (if (not (file-exists? dbarea)) |
︙ | ︙ |
Modified commonmod.scm from [409ebb7538] to [7e88abb9dd].
︙ | ︙ | |||
164 165 166 167 168 169 170 | (hash-table-ref/default cfgdat section '())) ;; dot-locking egg seems not to work, using this for now ;; if lock is older than expire-time then remove it and try again ;; to get the lock ;; (define (common:simple-file-lock fname #!key (expire-time 300)) | > > > | | | | | > | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | (hash-table-ref/default cfgdat section '())) ;; dot-locking egg seems not to work, using this for now ;; if lock is older than expire-time then remove it and try again ;; to get the lock ;; (define (common:simple-file-lock fname #!key (expire-time 300)) (let* ((lock-exists (file-exists? fname)) (fmod-time (if lock-exists (current-seconds) (handle-exceptions ext (current-seconds) (file-modification-time fname))))) (if lock-exists (if (> (- (current-seconds) fmod-time) expire-time) (begin (debug:print-info 1 *default-log-port* "Removing stale lock "fname) (handle-exceptions exn #f (delete-file* fname)) (common:simple-file-lock fname expire-time: expire-time)) #f) (let ((key-string (conc (get-host-name) "-" (current-process-id)))) (with-output-to-file fname (lambda () (print key-string))) |
︙ | ︙ |
Modified dashboard.scm from [349c7d2aed] to [d064a48d13].
︙ | ︙ | |||
115 116 117 118 119 120 121 | "-:p" ;; ignore the built in chicken profiling switch ) args:arg-hash 0)) (if (args:get-arg "-mode") (let* ((mode (string->symbol (args:get-arg "-mode")))) | | > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | "-:p" ;; ignore the built in chicken profiling switch ) args:arg-hash 0)) (if (args:get-arg "-mode") (let* ((mode (string->symbol (args:get-arg "-mode")))) (rmt:transport-mode mode)) (rmt:transport-mode 'tcp)) (if (args:get-arg "-test") ;; need to use tcp for test control panel (rmt:transport-mode 'tcp)) ;; RA => Might require revert for filters ;; create a watch dog to move changes from lt/.db/*.db to megatest.db ;; |
︙ | ︙ | |||
695 696 697 698 699 700 701 | 0 (dboard:rundat-last-update run-dat))) (last-db-time (if do-not-use-db-file-timestamps 0 (dboard:rundat-last-db-time run-dat))) (db-path (or (dboard:rundat-db-path run-dat) (let* ((db-dir (get-environment-variable "MT_RUN_AREA_HOME")) ;; (common:get-db-tmp-area)) | | | | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 | 0 (dboard:rundat-last-update run-dat))) (last-db-time (if do-not-use-db-file-timestamps 0 (dboard:rundat-last-db-time run-dat))) (db-path (or (dboard:rundat-db-path run-dat) (let* ((db-dir (get-environment-variable "MT_RUN_AREA_HOME")) ;; (common:get-db-tmp-area)) (db-pth (conc db-dir "/.mtdb/*.db"))) (dboard:rundat-db-path-set! run-dat db-pth) ;; this is just a cache of the path db-pth))) (db-mod-time (common:lazy-sqlite-db-modification-time db-path)) (db-modified (>= db-mod-time last-db-time)) (multi-get (> (dboard:rundat-run-data-offset run-dat) 0)) ;; multi-get in progress (tmptests (if (or do-not-use-db-file-timestamps (dboard:tabdat-filters-changed tabdat) db-modified) |
︙ | ︙ |
Modified db.scm from [d424f2ae6d] to [a33d322bf7].
︙ | ︙ | |||
560 561 562 563 564 565 566 | (data-synced 0) ;; count of changed records (tmp-area (common:get-db-tmp-area)) (old2new (member 'old2new options)) (dejunk (member 'dejunk options)) (killservers (member 'killservers options)) (src-area (if old2new *toppath* tmp-area)) (dest-area (if old2new tmp-area *toppath*)) | | > | 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 | (data-synced 0) ;; count of changed records (tmp-area (common:get-db-tmp-area)) (old2new (member 'old2new options)) (dejunk (member 'dejunk options)) (killservers (member 'killservers options)) (src-area (if old2new *toppath* tmp-area)) (dest-area (if old2new tmp-area *toppath*)) (dbfiles (if old2new (glob (conc *toppath* "/.mtdb/*.db")) (glob (conc tmp-area "/.mtdb/*.db")))) (keys (db:get-keys dbstruct)) (sync-durations (make-hash-table))) ;; kill servers (if killservers (db:kill-servers)) (if (not dbfiles) |
︙ | ︙ |