Megatest

Check-in [e24aa68ed5]
Login
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: e24aa68ed5a037613c1e73010dc444a269ebd935
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
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
179

180
181
182
183
184
185
186
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*
		     "ERROR: Version mismatch!\n"
		     "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
3273




3274
3275
3276
3277
3278
3279
3280
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)))
	(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
2

3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9

-
+







;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 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
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
1913
1914
1915
1916
1917
1918
1919
1920
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 ...
	      (include "readline-fix.scm")

	      (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