This is equivalent to a diff from
fb18a8da9e
to 8bd82d02ff
Modified dashboard-tests.scm
from [fe06b9cc98]
to [c70ca54366].
| ︙ | | |
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
|
407
408
409
410
411
412
413
414
415
416
417
418
419
420
|
-
|
(cmtcmd comment)
(iup:destroy! dlog))))))
(iup:button "Cancel"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(iup:destroy! dlog)))))))
dlog))
|
| ︙ | | |
Modified db.scm
from [725b61e04a]
to [cf4d2cae18].
| ︙ | | |
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
-
+
+
|
;;======================================================================
;;======================================================================
;; Database access
;;======================================================================
(require-extension (srfi 18) extras tcp)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n
md5 message-digest base64 format dot-locking z3 defstruct)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
|
| ︙ | | |
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
-
-
-
+
+
+
-
+
|
;; '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-mtime! dbstruct (current-milliseconds))
(dbr:dbstruct-set-rtime! dbstruct (current-milliseconds)))
(dbr:dbstruct-set-inuse! dbstruct #f)
(dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
(dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
(dbr:dbstruct-inuse-set! dbstruct #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* ((dbdat (if (vector? dbstruct)
(let* ((dbdat (if (dbr:dbstruct? dbstruct)
(db:get-db dbstruct run-id)
dbstruct)) ;; cheat, allow for passing in a dbdat
(db (db:dbdat-get-db dbdat)))
(db:delay-if-busy dbdat)
(handle-exceptions
exn
(begin
|
| ︙ | | |
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
-
+
-
-
+
+
|
(begin
(debug:print 2 "WARNING: opening db in non-writable dir " fname)
(sqlite3:open-database fname))))) ;; )
;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((local (dbr:dbstruct-get-local dbstruct))
(let* ((local (dbr:dbstruct-local dbstruct))
(rdb (if local
(dbr:dbstruct-get-localdb dbstruct run-id)
(dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
(dbr:dbstruct-localdb-set! dbstruct run-id)
(dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
(if (or rdb
do-not-open)
rdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
|
| ︙ | | |
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
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
280
281
|
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
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
280
281
282
|
-
-
-
+
+
+
-
+
-
+
-
+
-
+
-
-
+
+
|
(set! *megatest-db* db)
db)))
(write-access (file-write-access? dbpath))
;; (handler (make-busy-timeout 136000))
)
(if (and dbexists (not write-access))
(set! *db-write-access* #f)) ;; only unset so other db's also can use this control
(dbr:dbstruct-set-rundb! dbstruct (cons db dbpath))
(dbr:dbstruct-set-inuse! dbstruct #t)
(dbr:dbstruct-set-olddb! dbstruct olddb)
(dbr:dbstruct-rundb-set! dbstruct (cons db dbpath))
(dbr:dbstruct-inuse-set! dbstruct #t)
(dbr:dbstruct-olddb-set! dbstruct olddb)
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(mutex-unlock! *rundb-mutex*)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
(dbr:dbstruct-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-inmem! dbstruct inmem)
(dbr:dbstruct-inmem-set! 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
(db:sync-tables db:sync-tests-only db inmem)
(db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve?
(dbr:dbstruct-set-refdb! dbstruct refdb)
(dbr:dbstruct-refdb-set! dbstruct 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)))
(let ((mdb (dbr:dbstruct-main dbstruct)))
(if mdb
mdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
(dbdat (cons db dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-set-main! dbstruct dbdat)
(dbr:dbstruct-set-olddb! dbstruct olddb) ;; olddb is already a (cons db path)
(dbr:dbstruct-main-set! dbstruct dbdat)
(dbr:dbstruct-olddb-set! dbstruct olddb) ;; olddb is already a (cons db path)
(mutex-unlock! *rundb-mutex*)
(if (and (not dbexists)
*db-write-access*) ;; did not have a prior db and do have write access
(db:multi-db-sync #f 'old2new)) ;; migrate data from megatest.db automatically
dbdat)))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
|
| ︙ | | |
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
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
|
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
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
|
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
|
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(cons db dbpath)))
;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
(let ((mtime (dbr:dbstruct-get-mtime dbstruct))
(stime (dbr:dbstruct-get-stime dbstruct))
(rundb (dbr:dbstruct-get-rundb dbstruct))
(inmem (dbr:dbstruct-get-inmem dbstruct))
(maindb (dbr:dbstruct-get-main dbstruct))
(refdb (dbr:dbstruct-get-refdb dbstruct))
(olddb (dbr:dbstruct-get-olddb dbstruct))
(let ((mtime (dbr:dbstruct-mtime dbstruct))
(stime (dbr:dbstruct-stime dbstruct))
(rundb (dbr:dbstruct-rundb dbstruct))
(inmem (dbr:dbstruct-inmem dbstruct))
(maindb (dbr:dbstruct-main dbstruct))
(refdb (dbr:dbstruct-refdb dbstruct))
(olddb (dbr:dbstruct-olddb dbstruct))
;; (runid (dbr:dbstruct-get-run-id dbstruct))
)
(debug:print-info 4 "Syncing for run-id: " run-id)
;; (mutex-lock! *http-mutex*)
(if (eq? run-id 0)
;; runid equal to 0 is main.db
(if maindb
(if (or (not (number? mtime))
(not (number? stime))
(> mtime stime)
force-sync)
(begin
(db:delay-if-busy maindb)
(db:delay-if-busy olddb)
(let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
(dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
num-synced)
0))
(begin
;; this can occur when using local access (i.e. not in a server)
;; need a flag to turn it off.
;;
(debug:print 3 "WARNING: call to sync main.db to megatest.db but main not initialized")
0))
;; any other runid is a run
(if (or (not (number? mtime))
(not (number? stime))
(> mtime stime)
force-sync)
(begin
(db:delay-if-busy rundb)
(db:delay-if-busy olddb)
(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
(dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
(let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
;; (mutex-unlock! *http-mutex*)
num-synced)
(begin
;; (mutex-unlock! *http-mutex*)
0))))))
(define (db:close-main dbstruct)
(let ((maindb (dbr:dbstruct-get-main dbstruct)))
(let ((maindb (dbr:dbstruct-main dbstruct)))
(if maindb
(begin
(sqlite3:finalize! (db:dbdat-get-db maindb))
(dbr:dbstruct-set-main! dbstruct #f)))))
(dbr:dbstruct-main-set! dbstruct #f)))))
(define (db:close-run-db dbstruct run-id)
(let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
(if (and rdb
(sqlite3:database? rdb))
(begin
(sqlite3:finalize! rdb)
(dbr:dbstruct-set-localdb! dbstruct run-id #f)
(dbr:dbstruct-set-inmem! dbstruct #f)))))
(dbr:dbstruct-localdb-set! dbstruct run-id #f)
(dbr:dbstruct-inmem-set! dbstruct #f)))))
;; close all opened run-id dbs
(define (db:close-all dbstruct)
;; finalize main.db
(db:sync-touched dbstruct 0 force-sync: #t)
;;(common:db-block-further-queries)
;; (mutex-lock! *db-sync-mutex*) ;; with this perhaps it isn't necessary to use the block-further-queries mechanism?
(db:close-main dbstruct)
(let ((locdbs (dbr:dbstruct-get-locdbs dbstruct)))
(let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
(if (hash-table? locdbs)
(for-each (lambda (run-id)
(db:close-run-db dbstruct run-id))
(hash-table-keys locdbs))))
;; (let* ((local (dbr:dbstruct-get-local dbstruct))
;; (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))
|
| ︙ | | |
Modified db_records.scm
from [de0d03e562]
to [7f72a33adc].
| ︙ | | |
11
12
13
14
15
16
17
18
19
20
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
11
12
13
14
15
16
17
18
19
20
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
-
-
-
-
-
+
+
-
+
|
;; |-1.db
;; |-<N>.db
;;
;;
;; Accessors for a dbstruct
;;
(use defstruct)
(defstruct dbr:dbstruct main strdb path local rundb inmem mtime rtime stime inuse refdb locdbs olddb rundb-path)
;;; (define d1 (make-dbr:dbstruct))
;;; (dbr:dbstruct-main d1) ==> retrive value
;;; (dbr:dbstruct-main-set! d1 'def) ==> set value
(define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) ;; ( db path )
(define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 1)) ;; ( db path )
(define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 2))
(define-inline (dbr:dbstruct-get-local vec) (vector-ref vec 3))
(define-inline (dbr:dbstruct-get-rundb vec) (vector-ref vec 4)) ;; ( db path )
(define-inline (dbr:dbstruct-get-inmem vec) (vector-ref vec 5)) ;; ( db #f )
(define-inline (dbr:dbstruct-get-mtime vec) (vector-ref vec 6))
(define-inline (dbr:dbstruct-get-rtime vec) (vector-ref vec 7))
(define-inline (dbr:dbstruct-get-stime vec) (vector-ref vec 8))
(define-inline (dbr:dbstruct-get-inuse vec) (vector-ref vec 9))
(define-inline (dbr:dbstruct-get-refdb vec) (vector-ref vec 10)) ;; ( db path )
(define-inline (dbr:dbstruct-get-locdbs vec) (vector-ref vec 11))
(define-inline (dbr:dbstruct-get-olddb vec) (vector-ref vec 12)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-main-path vec) (vector-ref vec 13))
;; (define-inline (dbr:dbstruct-get-rundb-path vec) (vector-ref vec 14))
;; (define-inline (dbr:dbstruct-get-run-id vec) (vector-ref vec 13))
(define-inline (dbr:dbstruct-set-main! vec val)(vector-set! vec 0 val))
(define-inline (dbr:dbstruct-set-strdb! vec val)(vector-set! vec 1 val))
(define-inline (dbr:dbstruct-set-path! vec val)(vector-set! vec 2 val))
(define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 3 val))
(define-inline (dbr:dbstruct-set-rundb! vec val)(vector-set! vec 4 val))
(define-inline (dbr:dbstruct-set-inmem! vec val)(vector-set! vec 5 val))
(define-inline (dbr:dbstruct-set-mtime! vec val)(vector-set! vec 6 val))
(define-inline (dbr:dbstruct-set-rtime! vec val)(vector-set! vec 7 val))
(define-inline (dbr:dbstruct-set-stime! vec val)(vector-set! vec 8 val))
(define-inline (dbr:dbstruct-set-inuse! vec val)(vector-set! vec 9 val))
(define-inline (dbr:dbstruct-set-refdb! vec val)(vector-set! vec 10 val))
(define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val))
(define-inline (dbr:dbstruct-set-olddb! vec val)(vector-set! vec 12 val))
(define-inline (dbr:dbstruct-set-main-path! vec val)(vector-set! vec 13 val))
(define-inline (dbr:dbstruct-set-rundb-path! vec val)(vector-set! vec 14 val))
;; (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 1)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 2))
;; (define-inline (dbr:dbstruct-get-local vec) (vector-ref vec 3))
;; (define-inline (dbr:dbstruct-get-rundb vec) (vector-ref vec 4)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-inmem vec) (vector-ref vec 5)) ;; ( db #f )
;; (define-inline (dbr:dbstruct-get-mtime vec) (vector-ref vec 6))
;; (define-inline (dbr:dbstruct-get-rtime vec) (vector-ref vec 7))
;; (define-inline (dbr:dbstruct-get-stime vec) (vector-ref vec 8))
;; (define-inline (dbr:dbstruct-get-inuse vec) (vector-ref vec 9))
;; (define-inline (dbr:dbstruct-get-refdb vec) (vector-ref vec 10)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-locdbs vec) (vector-ref vec 11))
;; (define-inline (dbr:dbstruct-get-olddb vec) (vector-ref vec 12)) ;; ( db path )
;; ;; (define-inline (dbr:dbstruct-get-main-path vec) (vector-ref vec 13))
;; ;; (define-inline (dbr:dbstruct-get-rundb-path vec) (vector-ref vec 14))
;; ;; (define-inline (dbr:dbstruct-get-run-id vec) (vector-ref vec 13))
;;
;; (define-inline (dbr:dbstruct-set-main! vec val)(vector-set! vec 0 val))
;; (define-inline (dbr:dbstruct-set-strdb! vec val)(vector-set! vec 1 val))
;; (define-inline (dbr:dbstruct-set-path! vec val)(vector-set! vec 2 val))
;; (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 3 val))
;; (define-inline (dbr:dbstruct-set-rundb! vec val)(vector-set! vec 4 val))
;; (define-inline (dbr:dbstruct-set-inmem! vec val)(vector-set! vec 5 val))
;; (define-inline (dbr:dbstruct-set-mtime! vec val)(vector-set! vec 6 val))
;; (define-inline (dbr:dbstruct-set-rtime! vec val)(vector-set! vec 7 val))
;; (define-inline (dbr:dbstruct-set-stime! vec val)(vector-set! vec 8 val))
;; (define-inline (dbr:dbstruct-set-inuse! vec val)(vector-set! vec 9 val))
;; (define-inline (dbr:dbstruct-set-refdb! vec val)(vector-set! vec 10 val))
;; (define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val))
;; (define-inline (dbr:dbstruct-set-olddb! vec val)(vector-set! vec 12 val))
;; (define-inline (dbr:dbstruct-set-main-path! vec val)(vector-set! vec 13 val))
;; (define-inline (dbr:dbstruct-set-rundb-path! vec val)(vector-set! vec 14 val))
; (define-inline (dbr:dbstruct-set-run-id! vec val)(vector-set! vec 13 val))
;; constructor for dbstruct
;;
(define (make-dbr:dbstruct #!key (path #f)(local #f))
(define (actual-make-dbr:dbstruct #!key (path #f)(local #f))
(let ((v (make-vector 15 #f)))
(dbr:dbstruct-set-path! v path)
(dbr:dbstruct-set-local! v local)
(dbr:dbstruct-set-locdbs! v (make-hash-table))
v))
(define (dbr:dbstruct-get-localdb v run-id)
(hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))
(define (dbr:dbstruct-get-localdb v run-ids)
(hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))
(define (dbr:dbstruct-set-localdb! v run-id db)
(hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))
(hash-table-set! (dbr:dbstruct-locdbs v) run-id db))
(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id vec) (vector-ref vec 1))
(define-inline (db:test-get-testname vec) (vector-ref vec 2))
(define-inline (db:test-get-state vec) (vector-ref vec 3))
|
| ︙ | | |
Modified runs.scm
from [93791638c8]
to [4f79eba8a1].
| ︙ | | |
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
|
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
-
+
+
|
(debug:print 0 "Done")
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand)
(set-signal-handler! signal/stop sighand))
;; (set-signal-handler! signal/stop sighand) ;; should not be handling sigstop
)
(runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
(set! runconf (if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
(begin
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf)
#f)))
|
| ︙ | | |