Megatest

Check-in [a7af13fe19]
Login
Overview
Comment:wip; readonly watchdog not properly starting.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-readonly
Files: files | file ages | folders
SHA1: a7af13fe190cdd23e35b9234c7ac7a7a6bf43b10
User & Date: bjbarcla on 2017-02-21 17:54:33
Other Links: branch diff | manifest | tags
Context
2017-02-21
21:06
wip; readonly watchdog not properly starting. check-in: 1ae7e02473 user: bjbarcla tags: v1.63-readonly
17:54
wip; readonly watchdog not properly starting. check-in: a7af13fe19 user: bjbarcla tags: v1.63-readonly
17:10
fixed bug with loading area from Matt check-in: 8caaed5094 user: bjbarcla tags: v1.63-readonly
Changes

Modified common.scm from [3cdabe2c3a] to [dd5b90ba4c].

696
697
698
699
700
701
702

703

704

705
706





707


708
709
710
711
712
713
714
696
697
698
699
700
701
702
703
704
705
706
707


708
709
710
711
712
713
714
715
716
717
718
719
720
721
722







+

+

+
-
-
+
+
+
+
+

+
+







			(delay-loop (+ count 1))))
		  (if (not *time-to-exit*) (loop))))
	    (if (common:low-noise-print 30)
		(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" this-wd-num="this-wd-num)))))))

;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(define (common:watchdog)
  ;;#t)
  (BB> "common:watchdog entered.")

  (let ((dbstruct (db:setup)))
     (cond
    (if (dbr:dbstruct-read-only dbstruct)
        (common:readonly-watchdog dbstruct)
      ((dbr:dbstruct-read-only dbstruct)
       (BB> "loading read-only watchdog")
       common:readonly-watchdog dbstruct)
      (else
         (BB> "loading writable-watchdog.")
        (common:writable-watchdog dbstruct))))
     (BB> "watchdog done.");;)
 )


(define (std-exit-procedure)
  (on-exit (lambda () 0))
  ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
  (let ((no-hurry  (if *time-to-exit* ;; hurry up
		       #f

Modified dashboard.scm from [b9f4401444] to [6b53dd8ee7].

111
112
113
114
115
116
117

118

119
120
121
122
123
124
125
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127







+

+







    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(BB> "Before common:watchdog spawn")
    (thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(BB> "After common:watchdog spawn")
    (if (not (args:get-arg "-use-db-cache"))
	(begin
	  (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
	  (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)

;; data common to all tabs goes here
;;

Modified db.scm from [a536774740] to [47db56d212].

279
280
281
282
283
284
285

286
287
288

289
290
291
292
293
294
295
279
280
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296







+


-
+







        (let* ((dbpath       (db:dbfile-path)) ;;  0))
               (dbexists     (file-exists? dbpath))
	       (dbfexists    (file-exists? (conc dbpath "/megatest.db")))
               (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
               (mtdb         (db:open-megatest-db))
               (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
               (write-access (file-write-access? dbpath)))
          (BB> "db:open-db>> dbpath="dbpath" dbexists="dbexists" and write-access="write-access)
          (if (and dbexists (not write-access))
              (begin (set! *db-write-access* #f)
                     (dbr:dbstruct-readonly-set! dbstruct #t)))
                     (dbr:dbstruct-read-only-set! dbstruct #t)))
          (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
          (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
          (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
          (dbr:dbstruct-refndb-set! dbstruct refndb)
          ;;	    (mutex-unlock! *rundb-mutex*)
          (if (and (not dbfexists)
310
311
312
313
314
315
316

317
318
319
320
321
322
323
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325







+







  (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)
      (BB> "new dbstruct = "(dbr:dbstruct->alist 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))))

;; Open the classic megatest.db file (defaults to open in toppath)
;;