Overview
| Comment: | moved readline fix include out of the if. Update copyright date. Block when running db migration IF version bumped |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.62 |
| Files: | files | file ages | folders |
| SHA1: |
e24aa68ed5a037613c1e73010dc444a2 |
| User & Date: | mrwellan on 2016-09-21 09:11:42 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-09-26
| ||
| 13:40 | Convert from vector record to defstruct for dbr:dbstruct check-in: 7c0396e31d user: mrwellan tags: v1.62 | |
|
2016-09-23
| ||
| 15:18 | Update db check-in: b6c50d722b user: ritikaag tags: db | |
| 11:16 | merged with latest v1.62 check-in: d9c3068419 user: srehman tags: defstruct-srehman | |
|
2016-09-21
| ||
| 09:11 | moved readline fix include out of the if. Update copyright date. Block when running db migration IF version bumped check-in: e24aa68ed5 user: mrwellan tags: v1.62 | |
|
2016-09-19
| ||
| 11:08 | Put the db migration into a thread to not block starting the dashboard check-in: 3046301f07 user: mrwellan tags: v1.62 | |
Changes
Modified common.scm from [dbd6b46d99] to [b0ca248a45].
| ︙ | ︙ | |||
144 145 146 147 148 149 150 151 152 153 154 155 156 157 | (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) ;; from metadat lookup MEGATEST_VERSION ;; (define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB (rmt:get-var "MEGATEST_VERSION")) (define (common:set-last-run-version) (rmt:set-var "MEGATEST_VERSION" (common:version-signature))) (define (common:version-changed?) (not (equal? (common:get-last-run-version) (common:version-signature)))) | > > > > | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 | (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) ;; from metadat lookup MEGATEST_VERSION ;; (define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB (rmt:get-var "MEGATEST_VERSION")) (define (common:get-last-run-version-number) (string->number (substring (common:get-last-run-version) 0 6))) (define (common:set-last-run-version) (rmt:set-var "MEGATEST_VERSION" (common:version-signature))) (define (common:version-changed?) (not (equal? (common:get-last-run-version) (common:version-signature)))) |
| ︙ | ︙ | |||
172 173 174 175 176 177 178 |
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
(if (common:version-changed?)
(let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config")))
(debug:print 0 *default-log-port*
| | | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
(if (common:version-changed?)
(let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config")))
(debug:print 0 *default-log-port*
"WARNING: Version mismatch!\n"
" expected: " (common:version-signature) "\n"
" got: " (common:get-last-run-version))
(if (and (file-exists? mtconf)
(eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
(begin
(debug:print 0 *default-log-port* " I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
(handle-exceptions
|
| ︙ | ︙ |
Modified dashboard.scm from [1427634bc5] to [40b640dfe5].
| ︙ | ︙ | |||
3266 3267 3268 3269 3270 3271 3272 |
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(define (main)
(if (not (args:get-arg "-skip-version-check"))
(let ((th1 (make-thread common:exit-on-version-changed)))
| | > > > | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 |
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(define (main)
(if (not (args:get-arg "-skip-version-check"))
(let ((th1 (make-thread common:exit-on-version-changed)))
(thread-start! th1)
(if (> megatest-version (common:get-last-run-version-number))
(debug:print-info 0 *default-log-port* "Version bump detected, blocking until db sync complete")
(thread-join! th1))))
(let* ((commondat (dboard:commondat-make)))
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
(cond
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) ;; RADT couldn't find string->number, though it works
(if (> (length d) 1)
d
|
| ︙ | ︙ |
Modified db.scm from [e5eb1c89ac] to [248b7f3532].
1 | ;;====================================================================== | | | 1 2 3 4 5 6 7 8 9 | ;;====================================================================== ;; Copyright 2006-2016, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. |
| ︙ | ︙ |
Modified megatest.scm from [36ef6b845c] to [c9c26e5538].
| ︙ | ︙ | |||
1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 |
(set! *didsomething* #t)))
;;======================================================================
;; Start a repl
;;======================================================================
;; fakeout readline
(if (or (getenv "MT_RUNSCRIPT")
(args:get-arg "-repl")
(args:get-arg "-load"))
(let* ((toppath (launch:setup))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
(if dbstruct
| > | 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 |
(set! *didsomething* #t)))
;;======================================================================
;; Start a repl
;;======================================================================
;; fakeout readline
(include "readline-fix.scm")
(if (or (getenv "MT_RUNSCRIPT")
(args:get-arg "-repl")
(args:get-arg "-load"))
(let* ((toppath (launch:setup))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
(if dbstruct
|
| ︙ | ︙ | |||
1906 1907 1908 1909 1910 1911 1912 | (set! *db* dbstruct) (set! *client-non-blocking-mode* #t) (import extras) ;; might not be needed ;; (import csi) (import readline) (import apropos) ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ... | < | 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 | (set! *db* dbstruct) (set! *client-non-blocking-mode* #t) (import extras) ;; might not be needed ;; (import csi) (import readline) (import apropos) ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ... (if *use-new-readline* (begin (install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines]) (current-input-port (make-readline-port "megatest> "))) (begin (gnu-history-install-file-manager |
| ︙ | ︙ |