Megatest

Check-in [6eef552c2e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed db running bug
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 6eef552c2e9f85bb401cb0993a7c347b5001c1f6
User & Date: matt on 2014-12-15 00:16:32
Other Links: branch diff | manifest | tags
Context
2014-12-15
22:51
Flattened unnecessary hierarchy from paths in bup repositories check-in: 4aa76fc692 user: matt tags: v1.60
00:16
Fixed db running bug check-in: 6eef552c2e user: matt tags: v1.60
2014-12-14
21:47
Added unit test to exercise server cycle check-in: 004afb0916 user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [4fc536addb] to [3172f4a26d].

︙
232
233
234
235
236
237
238

239

240
241

242
243
244
245
246




247
248
249
250
251
252
253

232
233
234
235
236
237
238
239

240
241

242
243




244
245
246
247
248
249
250
251
252
253
254








+
-
+

-
+

-
-
-
-
+
+
+
+








	  ;; (dbr:dbstruct-set-run-id! dbstruct run-id)
	  (if local
	      (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)
		;; 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
		;; (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*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))
    (if mdb
︙
548
549
550
551
552
553
554




555
556
557
558
559
560
561

549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566








+
+
+
+








	       (if (> (length fromdat) batch-len)
		   (begin
		     (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
	     (lambda (a . b)
	       (hash-table-set! todat a (apply vector a b)))
︙

Modified http-transport.scm from [30e3275ed4] to [c3c2fc0fe7].

︙
435
436
437
438
439
440
441



442
443
444
445
446
447
448

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451








+
+
+








	  (if (eq? server-state 'available)
	      (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
		(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))))))
      
      (if (< count 1) ;; 3x3 = 9 secs aprox
	  (loop (+ count 1) 'running bad-sync-count))
︙

Modified rmt.scm from [40211cab4f] to [26510b9ee8].

︙
65
66
67
68
69
70
71



72
73
74
75
76
77
78

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81








+
+
+








	 (if (and (> count 10)
		  (> queries-per-second 10))
	     (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 ...
	;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
	(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
︙
136
137
138
139
140
141
142
143





144
145
146
147
148
149
150

139
140
141
142
143
144
145

146
147
148
149
150
151
152
153
154
155
156
157








-
+
+
+
+
+









		;; no longer killing the server in http-transport:client-api-send-receive
		;; 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*)
	      (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
	      ;; (client:setup run-id) ;; client setup happens in rmt:get-connection-info
︙

Modified tests/unittests/server.scm from [c4b3b05ca3] to [d45af24828].

︙
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40



41

42
43
44
45
46
47
48

21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37



38
39
40

41
42
43
44
45
46
47
48








-
+









-
-
-
+
+
+
-
+








(define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
(define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))

(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))
	 (first-dat   (if (not (null? server-dats))
			  (car server-dats)
︙
61
62
63
64
65
66
67

68
69
70
71
72
73
74

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75








+








       (server:kind-run run-id)
       (loop 'server-started))
      ((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))
	 ((no-dat)
	  (loop test-state))
︙

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