Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -234,18 +234,19 @@ (begin (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ... db) (begin (dbr:dbstruct-set-inmem! dbstruct inmem) - (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context + ;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders + ;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context (db:sync-tables db:sync-tests-only db inmem) - (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) + (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? (dbr:dbstruct-set-refdb! dbstruct refdb) - (db:sync-tables db:sync-tests-only db refdb) - ;; sync once more to deal with delays - (db:sync-tables db:sync-tests-only db inmem) - (db:sync-tables db:sync-tests-only db refdb) + (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db + ;; sync once more to deal with delays? + ;; (db:sync-tables db:sync-tests-only db inmem) + ;; (db:sync-tables db:sync-tests-only inmem refdb) inmem)))))) ;; This routine creates the db. It is only called if the db is not already ls opened ;; (define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) @@ -550,10 +551,14 @@ (set! fromdats (cons fromdat fromdats)) (set! fromdat '()) (set! totrecords (+ totrecords 1))))) (db:dbdat-get-db fromdb) full-sel) + + ;; tack on remaining records in fromdat + (if (not (null? fromdat)) + (set! fromdats (cons fromdat fromdats))) (debug:print-info 2 "found " totrecords " records to sync") ;; read the target table (sqlite3:for-each-row Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -437,10 +437,13 @@ (if (equal? new-server-id server-id) (begin (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep") (thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access (set! *inmemdb* (db:setup run-id)) + ;; force initialization + ;; (db:get-db *inmemdb* #t) + (db:get-db *inmemdb* run-id) (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")) (begin ;; gotta exit nicely (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision") (http-transport:server-shutdown server-id port)))))) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -67,10 +67,13 @@ (begin (debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second) #t) #f)))) +;; if a server is either running or in the process of starting call client:setup +;; else return #f to let the calling proc know that there is no server available +;; (define (rmt:get-connection-info run-id) (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo ;; NB// can cache the answer for server running for 10 seconds ... @@ -138,11 +141,15 @@ ;; may kill it here but what are the criteria? ;; start with three calls then kill server ;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id)) ;; (thread-sleep! 2) (rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))) - ;; no connection info? try to start a server + ;; no connection info? try to start a server, or access locally if no + ;; server and the query is read-only + ;; + ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call + ;; (if (and (< attemptnum 15) (member cmd api:write-queries)) (begin (hash-table-delete! *runremote* run-id) ;; (mutex-unlock! *send-receive-mutex*) Index: tests/unittests/server.scm ================================================================== --- tests/unittests/server.scm +++ tests/unittests/server.scm @@ -23,24 +23,24 @@ (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user)) ;; (test #f #f (rmt:get-runs-by-patt keys runname)) (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" "")) (define test-one-id #f) -(test #f 1 (let ((test-id (rmt:get-test-id run-id "test-one" ""))) +(test #f 30001 (let ((test-id (rmt:get-test-id run-id "test-one" ""))) (set! test-one-id test-id) test-id)) (define test-one-rec #f) (test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id))) (set! test-one-rec test-rec) (vector-ref test-rec 2))) (use trace) (import trace) -(trace - rmt:send-receive - rmt:open-qry-close-locally -) +;; (trace +;; rmt:send-receive +;; rmt:open-qry-close-locally +;; ) ;; Tests to assess reading/writing while servers are starting/stopping (define start-time (current-seconds)) (let loop ((test-state 'start)) (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id)) @@ -63,10 +63,11 @@ ((server-started) (case server-state ((running) (print "Server appears to be running. Now ask it to shutdown") (rmt:kill-server run-id) + ;; (trace rmt:open-qry-close-locally rmt:send-receive) (loop 'shutdown-started)) ((available) (loop test-state)) ((shutting-down) (loop test-state))