Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -116,14 +116,14 @@ ;; ;;;(if (file-write-access? (conc *toppath* "/megatest.db")) ;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn") (thread-start! (make-thread common:watchdog "Watchdog thread")) ;;(debug:print-info 13 *default-log-port* "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)));;;) +;; (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 ;; (defstruct dboard:commondat ((curr-tab-num 0) : number) @@ -541,14 +541,15 @@ (run-dat (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f) (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals))) (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd) rd))) ;; (prev-tests (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1)) - (last-update (if (or do-not-use-query-timestamps - (dboard:tabdat-filters-changed tabdat)) - 0 - (dboard:rundat-last-update run-dat))) + (last-update (if ;;(or + do-not-use-query-timestamps + ;;(dboard:tabdat-filters-changed tabdat)) + 0 + (dboard:rundat-last-update run-dat))) (last-db-time (if do-not-use-db-file-timestamps 0 (dboard:rundat-last-db-time run-dat))) (db-path (or (dboard:rundat-db-path run-dat) (let* ((db-dir (common:get-db-tmp-area)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -279,13 +279,14 @@ (let* ((dbpath (db:dbfile-path )) ;; path to tmp db area (dbexists (file-exists? dbpath)) (tmpdbfname (conc dbpath "/megatest.db")) (dbfexists (file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db"))) (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) + (mtdbexists (file-exists? (conc *toppath* "/megatest.db"))) (mtdb (db:open-megatest-db)) (mtdbpath (db:dbdat-get-path mtdb)) - (mtdbexists (file-exists? mtdbpath)) + (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? mtdbpath)) (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime)))) @@ -299,20 +300,19 @@ (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 write-access - (or (not dbfexists) - (and modtimedelta - (> modtimedelta 10)))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back + (if (or (not dbfexists) + (and modtimedelta + (> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back (begin - (debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) + (debug:print 4 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb) (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.") ) - (debug:print 0 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) ) + (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) ) ;; (db:multi-db-sync dbstruct 'old2new)) ;; migrate data from megatest.db automatically tmpdb)))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.6308) +(define megatest-version 1.6309) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -906,11 +906,12 @@ ((string=? (args:get-arg "-dumpmode") "ini") (configf:config->ini data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t) - (pop-directory))) + (pop-directory) + (set! *time-to-exit* #t))) (if (args:get-arg "-show-cmdinfo") (if (or (args:get-arg ":value")(getenv "MT_CMDINFO")) (let ((data (common:read-encoded-string (or (args:get-arg ":value")(getenv "MT_CMDINFO"))))) (if (equal? (args:get-arg "-dumpmode") "json")