Megatest

Check-in [4af84cb819]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Got -import-megatest.db working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | inmem-per-run-db
Files: files | file ages | folders
SHA1: 4af84cb81948c98a6f99459a0222ddc4961986d6
User & Date: matt on 2013-11-30 09:24:30
Other Links: branch diff | manifest | tags
Context
2013-11-30
10:12
Force sync for now check-in: eac279e14a user: matt tags: inmem-per-run-db
09:24
Got -import-megatest.db working check-in: 4af84cb819 user: matt tags: inmem-per-run-db
08:15
Still hosed check-in: cfb597082f user: matt tags: inmem-per-run-db
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [408545c812] to [a5a1f9f0f0].

︙
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82

68
69
70
71
72
73
74

75
76
77
78
79
80
81
82








-
+








    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
					  (run-id     (cadr params))
					  (realparams (cddr params)))
				      (db:with-db dbstruct run-id #t ;; these are all for modifying the db
						  (lambda (db)
						    (db:general-call db stmtname realparams)))))
    ((sync-inmem->db)               (db:sync-touched dbstruct))
    ((sync-inmem->db)               (db:sync-touched dbstruct force-sync: #t))
    ((kill-server)
     (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)  ;; (db:sync-to *inmemdb* *db*)
     (let ((hostname (car  *runremote*))
	   (port     (cadr *runremote*))
	   (pid      (if (null? params) #f (car params)))
	   (th1      (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))
       (debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
︙

Modified db.scm from [2cba8158d4] to [aabc9033ad].

︙
62
63
64
65
66
67
68


69
70
71
72
73
74






75
76
77
78
79
80
81

62
63
64
65
66
67
68
69
70






71
72
73
74
75
76
77
78
79
80
81
82
83








+
+
-
-
-
-
-
-
+
+
+
+
+
+








	  db))))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;;
(define (db:done-with dbstruct run-id mod-read)
  (if (not (sqlite3:database? dbstruct))
      (begin
  (mutex-lock! *rundb-mutex*)
  (if (eq? mod-read 'mod)
      (dbr:dbstruct-set-runvec-val! dbstruct run-id 'mtime (current-milliseconds))
      (dbr:dbstruct-set-runvec-val! dbstruct run-id 'rtime (current-milliseconds)))
  (dbr:dbstruct-set-runvec-val! dbstruct run-id 'inuse #f)
  (mutex-unlock! *rundb-mutex*))
	(mutex-lock! *rundb-mutex*)
	(if (eq? mod-read 'mod)
	    (dbr:dbstruct-set-runvec-val! dbstruct run-id 'mtime (current-milliseconds))
	    (dbr:dbstruct-set-runvec-val! dbstruct run-id 'rtime (current-milliseconds)))
	(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inuse #f)
	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((db (db:get-db dbstruct run-id)))
    (let ((res (apply proc db params)))
︙
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216


217
218
219



220
221
222
223

224
225
226
227
228
229
230

202
203
204
205
206
207
208

209
210
211
212
213
214
215
216


217
218
219


220
221
222
223
224
225
226
227
228
229
230
231
232
233
234








-
+







-
-
+
+

-
-
+
+
+




+








    (if (not dbexists)
	(begin
	  (db:initialize-main-db db)
	  (db:initialize-run-id-db db)))
    db))

;; sync all touched runs to disk
(define (db:sync-touched dbstruct)
(define (db:sync-touched dbstruct #!key (force-sync #f))
  (let ((tot-synced 0))
    (for-each
     (lambda (runvec)
       (let ((mtime (vector-ref runvec (dbr:dbstruct-field-name->num 'mtime)))
	     (stime (vector-ref runvec (dbr:dbstruct-field-name->num 'stime)))
	     (rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb)))
	     (inmem (vector-ref runvec (dbr:dbstruct-field-name->num 'inmem))))
	 (if (> mtime stime)
	     (let ((num-sunced (db:sync-tables db:sync-tests-only inmem rundb)))
	 (if (or (> mtime stime) force-sync)
	     (let ((num-synced (db:sync-tables db:sync-tests-only inmem rundb)))
	       (set! tot-synced (+ tot-synced num-synced))
	       (vector-set! runvec (dbr:dbstruct-field-name->run 'stime (current-milliseconds)))))))
     (hash-table-values (vector-ref dbstruct 1)))))
	       (vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds))))))
     (hash-table-values (vector-ref dbstruct 1)))
    tot-synced))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  ;; finalize main.db
  (db:sync-touched dbstruct force-sync: #t)
  (sqlite3:finalize! (db:get-db dbstruct #f))
  (for-each
   (lambda (runvec)
     (let ((rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb))))
       (if (sqlite3:database? rundb)
	   (sqlite3:finalize! rundb)
	   (debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database"))))
︙
251
252
253
254
255
256
257
258
259


260
261
262
263
264

265
266
267
268
269
270
271
272

273
274
275
276
277
278
279

255
256
257
258
259
260
261


262
263
264
265
266
267

268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283








-
-
+
+




-
+







-
+








	 '("id"             #f)
	 '("run_id"         #f)
	 '("testname"       #f)
	 '("host"           #f)
	 '("cpuload"        #f)
	 '("diskfree"       #f)
	 '("uname"          #f)
	 '("rundir"      #f)
	 '("shortdir"    #f)
	 '("rundir"         #f)
	 '("shortdir"       #f)
	 '("item_path"      #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("attemptnum"     #f)
	 '("final_logf"  #f)
	 '("final_logf"     #f)
	 '("logdat"         #f)
	 '("run_duration"   #f)
	 '("comment"        #f)
	 '("event_time"     #f)
	 '("fail_count"     #f)
	 '("pass_count"     #f)
	 '("archived"       #f))
   (list "test_steps"
  (list "test_steps"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("stepname"       #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("event_time"     #f)
	 '("comment"        #f)
︙
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
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

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
319








-
+












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:tbls db)
(define (db:sync-main-list db)
  (let ((keys  (db:get-keys db)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 
		   '("id"  #f))
	     (map (lambda (k)(list k #f))
		  (append keys
			  (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))))
     (list "tests" 
	   '("id"             #f)
	   '("run_id"         #f)
	   '("testname"       #f)
	   '("host"           #f)
	   '("cpuload"        #f)
	   '("diskfree"       #f)
	   '("uname"          #f)
	   '("rundir"         #f)
	   '("shortdir"       #f)
	   '("item_path"      #f)
	   '("state"          #f)
	   '("status"         #f)
	   '("attemptnum"     #f)
	   '("final_logf"     #f)
	   '("logdat"         #f)
	   '("run_duration"   #f)
	   '("comment"        #f)
	   '("event_time"     #f)
	   '("fail_count"     #f)
	   '("pass_count"     #f)
	   '("archived"       #f))
     (list "test_steps"
	   '("id"             #f)
	   '("test_id"        #f)
	   '("stepname"       #f)
	   '("state"          #f)
	   '("status"         #f)
	   '("event_time"     #f)
	   '("comment"        #f)
	   '("logfile"        #f))
     (list "test_meta"
	   '("id"             #f)
	   '("testname"       #f)
	   '("owner"          #f)
	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
︙
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442

399
400
401
402
403
404
405



406
407
408
409
410
411
412








-
-
-








	       (count   (cdr dat)))
	   (set! tot-count (+ tot-count count))
	   (if (> count 0)
	       (debug:print 0 (format #f "    ~10a ~5a" tblname count)))))
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
    tot-count))

(define (db:sync-back)
  (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db (cond
		  ((sqlite3:database? idb)     idb)
︙
1423
1424
1425
1426
1427
1428
1429


1430
1431
1432
1433
1434
1435
1436
1437
1438
1439










1440
1441
1442
1443
1444
1445
1446

1393
1394
1395
1396
1397
1398
1399
1400
1401










1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418








+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+








		       res)))
     (db:get-db dbstruct run-id)
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE run_id=?;")
     run-id)
    res))

(define (db:replace-test-records dbstruct run-id testrecs)
  (db:with-db dbstruct run-id #t 
	      (lambda (db)
  (let* ((qmarks (string-intersperse (make-list (length db:test-record-fields) "?") ","))
	 (qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ");"))
	 (qry    (sqlite3:prepare (db:get-db dbstruct run-id) qrystr)))
    (debug:print 8 "INFO: replace-test-records, qrystr=" qrystr)
    (for-each 
     (lambda (rec)
       ;; (debug:print 0 "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ", "))
       (apply sqlite3:execute qry (vector->list rec)))
     testrecs)
    (sqlite3:finalize! qry)))
		(let* ((qmarks (string-intersperse (make-list (length db:test-record-fields) "?") ","))
		       (qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ");"))
		       (qry    (sqlite3:prepare db qrystr)))
		  ;; (debug:print 8 "INFO: replace-test-records, qrystr=" qrystr)
		  (for-each 
		   (lambda (rec)
		     (debug:print 0 "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ", "))
		     (apply sqlite3:execute qry (vector->list rec)))
		   testrecs)
		  (sqlite3:finalize! qry)))))
	

;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (let ((db (db:get-db dbstruct run-id))
	(res #f))
    (sqlite3:for-each-row
︙

Modified db_records.scm from [1641bf9d8d] to [832e173195].

︙
37
38
39
40
41
42
43
44
45


46
47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64

37
38
39
40
41
42
43


44
45
46
47
48
49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
64








-
-
+
+











-
+








(define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 4 val))

;; get a rundb vector, create it if not already existing
(define (dbr:dbstruct-get-rundb-rec vec run-id)
  (let* ((dbhash (dbr:dbstruct-get-dbhash vec))              ;; get the runs hash
	 (runvec (hash-table-ref/default dbhash run-id #f))) ;; get the vector for run-id
    (if (vector? runvec)
	runvec
	(let ((nvec  (vector #f #f -1 -1 -1 #f)))
	runvec ;;           rundb inmemdb last-mod last-read last-sync in-use
	(let ((nvec  (vector #f      #f       -1       -1       -1       #f)))
	  (hash-table-set! dbhash run-id nvec)
	  nvec))))

;;  [ rundb inmemdb last-mod last-read last-sync ]
(define-inline (dbr:dbstruct-field-name->num field-name)
  (case field-name
    ((rundb) 0) ;; the on-disk db
    ((inmem) 1) ;; the in-memory db
    ((mtime) 2) ;; last modification time
    ((rtime) 3) ;; last read time
    ((stime) 4) ;; last sync time
    ((inuse) 5) ;; is the db currently in use
    ((inuse) 5) ;; is the db currently in use, #t yes, #f no.
    (else -1)))

;; get/set rundb fields
(define (dbr:dbstruct-get-runvec-val vec run-id field-name)
  (let ((runvec   (dbr:dbstruct-get-rundb-rec vec run-id))
	(fieldnum (dbr:dbstruct-field-name->num field-name)))
    ;; (vector-set! runvec (dbr:dbstruct-field-name->num 'inuse) #t)
︙

Modified megatest.scm from [c3002b1e2f] to [ef3627057f].

︙
1189
1190
1191
1192
1193
1194
1195


1196
1197
1198
1199
1200
1201
1202

1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204








+
+








      (set! *didsomething* #t)))

(if (args:get-arg "-import-megatest.db")
    (let* ((toppath  (setup-for-run))
	   (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	   (mtdb     (if toppath (db:open-megatest-db)))
	   (run-ids  (if toppath (db:get-run-ids mtdb))))
      ;; sync runs, test_meta etc.
      (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
      (for-each 
       (lambda (run-id)
	 (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	   (debug:print 0 "INFO: Updating " (length testrecs) " records for run-id=" run-id)
	   (db:replace-test-records dbstruct run-id testrecs)))
       run-ids)
      (set! *didsomething* #t)
︙

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