Megatest

Check-in [ee0d52f1d2]
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

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
   "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)))
	    (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
		   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))))
	  (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
;;======================================================================







|
>
>
|




>
|
|
<
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|







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"))
                (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
             ((and (file-exists? mtconf) (file-exists? dbfile) (not read-only)
                   (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db

              (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
;;
(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)
      (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))))








|







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)))
      (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))))