| ︙ | | |
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
+
|
(if rdb
rdb
(let* ((local (dbr:dbstruct-get-local dbstruct))
(toppath (dbr:dbstruct-get-path dbstruct))
(dbpath (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
(inmem (if local #f (db:open-inmem-db)))
(refdb (if local #f (db:open-inmem-db)))
(db (sqlite3:open-database dbpath))
(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
(if write-access
(begin
|
| ︙ | | |
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
+
+
|
(if local
(begin
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inmem db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inmem inmem)
(db:sync-tables db:sync-tests-only db inmem)
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'refdb refdb)
(db:sync-tables db:sync-tests-only db refdb)
inmem))))))
;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
|
| ︙ | | |
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
-
-
-
-
-
-
-
-
-
-
|
db))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
(let ((dbstruct (make-dbr:dbstruct path: *toppath* local: local)))
(db:get-db dbstruct #f) ;; force one call to main
;; (if (not sdb:qry)
;; (begin
;; (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
;; (sdb:qry 'setup #f)
;; ;; Initialize with some known needed strings, NOTE: set this up to only execute on first db initialization
;; (for-each
;; (lambda (str)
;; (sdb:qry 'get-id str))
;; (list "" "logs/final.log"))))
;; (set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db")))
|
| ︙ | | |
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
|
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
|
-
-
+
+
+
+
-
-
-
+
|
(conc fieldname " " wildtype " '" patt "'")))
(if (null? patts)
'("")
patts))
comparator)))
;; register a test run with the db
(define (db:register-run dbstruct keyvals runname state status user)
;; register a test run with the db, this accesses the main.db and does NOT
;; use server api
;;
(define (db:register-run db keyvals runname state status user)
(debug:print 3 "runs:register-run runname: " runname " state: " state " status: " status " user: " user)
(let* ((db (db:get-db dbstruct #f))
(keys (map car keyvals))
|
| ︙ | | |