Megatest

Check-in [ee0d52f1d2]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:resolved deadlock in db:setup; fixed read-only detection in db migration proc
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-readonly
Files: files | file ages | folders
SHA1: ee0d52f1d2083095a76895346a4a87a57c398558
User & Date: bjbarcla on 2017-02-21 14:28:31
Other Links: branch diff | manifest | tags
Context
2017-02-21
16:49
fixed bug with loading area from Matt check-in: 044051d315 user: bjbarcla tags: v1.63-readonly
14:28
resolved deadlock in db:setup; fixed read-only detection in db migration proc check-in: ee0d52f1d2 user: bjbarcla tags: v1.63-readonly
14:03
fixed gross bugs; first time ovbserved read-only mode working (-list-runs) check-in: 6d7e5ab283 user: bjbarcla tags: v1.63-readonly
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [b1fdaa9a5c] to [892351b73c].

︙
270
271
272
273
274
275
276
277
278




279
280
281
282

283
284


285
286
287
288
289
290
291
292
293
294
295
296
297
























298
299
300
301
302
303
304

270
271
272
273
274
275
276


277
278
279
280
281
282
283
284
285


286
287













288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318








-
-
+
+
+
+




+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








   "logs"))

;; 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?)
      (if (common:on-homehost?)
	  (let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
		(dbstruct (db:setup)))
	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
                (dbfile (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.db"))
                (read-only (not (file-write-access? dbfile)))
                (dbstruct (db:setup)))
	    (debug:print 0 *default-log-port*
			 "WARNING: Version mismatch!\n"
			 "   expected: " (common:version-signature) "\n"
			 "   got:      " (common:get-last-run-version))
            (cond
	    (if (and (file-exists? mtconf)
		     (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
             ((and (file-exists? mtconf) (file-exists? dbfile) (not read-only)
                   (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
		   exn
		   (begin
		     (debug:print 0 *default-log-port* "Failed to switch versions.")
		     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
		     (print-call-chain (current-error-port))
		     (exit 1))
		   (common:cleanup-db dbstruct)))
		(begin
		  (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
		  (exit 1))))
              (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
               exn
               (begin
                 (debug:print 0 *default-log-port* "Failed to switch versions.")
                 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
                 (print-call-chain (current-error-port))
                 (exit 1))
               (common:cleanup-db dbstruct)))
             ((not (file-exists? mtconf))
              (debug:print 0 *default-log-port* "   megatest.config does not exist in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             ((not (file-exists? dbfile))
              (debug:print 0 *default-log-port* "   megatest.db does not exist in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             ((not (eq? (current-user-id)(file-owner mtconf)))
              (debug:print 0 *default-log-port* "   You do not own megatest.db in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             (read-only
              (debug:print 0 *default-log-port* "   You have read-only access to this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             (else
              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
              (exit 1))))
	  (begin
	    (debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
	    (exit 1)))))

;;======================================================================
;; S P A R S E   A R R A Y S
;;======================================================================
︙

Modified db.scm from [5de40dea1a] to [ef6be90d9f].

︙
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321

307
308
309
310
311
312
313

314
315
316
317
318
319
320
321








-
+








;;
(define (db:setup #!key (areapath #f))
  ;;
  (cond
   (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
   (else ;;(common:on-homehost?)
    (let* ((dbstruct (make-dbr:dbstruct)))
      (launch:setup areapath: areapath)
      (when (not *toppath*) (launch:setup areapath: areapath))
      (db:open-db dbstruct areapath: areapath)
      (set! *dbstruct-db* dbstruct)
      dbstruct))))
   ;; (else
   ;;  (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
   ;;  (exit 1))))
︙

This page was generated in about 0.124s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00