Megatest

Check-in [fe6e866e85]
Login
Overview
Comment:implemented db:get-db with extra runid arg
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.7001-multi-db-get-db | v1.7001-multi-db-rb01
Files: files | file ages | folders
SHA1: fe6e866e8559175a7bc3f33bb2d2d1ad45c3e889
User & Date: mmgraham on 2022-04-08 14:52:19
Other Links: branch diff | manifest | tags
Context
2022-04-10
20:05
Merged Martin's fix. Got commonmod, debugprint and mtargs modules working check-in: 911725fc69 user: matt tags: v1.7001-multi-db-wip, v1.7001-multi-db-rb01
2022-04-08
14:52
implemented db:get-db with extra runid arg Closed-Leaf check-in: fe6e866e85 user: mmgraham tags: v1.7001-multi-db-get-db, v1.7001-multi-db-rb01
2022-04-06
18:21
fixed readonly detection check-in: 51deb29dc4 user: mmgraham tags: v1.7001-multi-db-rb01
Changes

Modified db.scm from [5b6dbaca58] to [cecb20422b].

159
160
161
162
163
164
165
166
167


168
169
170

171
172
173
174
175


176
177




178
179
180
181
182
183
184
159
160
161
162
163
164
165


166
167



168





169
170


171
172
173
174
175
176
177
178
179
180
181







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







;;    if run-id is a string treat it as a filename
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
;; (define db:get-db db:get-subdb)

;; (define (db:get-db subdb #;dbstruct run-id) ;; RENAME TO db:get-dbh
;;   ;; (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
(define (db:get-db dbstruct run-id) 
   (let* ((subdb (dbfile:get-subdb dbstruct run-id))
;;     (if (stack? (dbr:subdb-dbstack subdb))
;; 	(if (stack-empty? (dbr:subdb-dbstack subdb))
;; 	    (let* ((dbname (db:run-id->dbname run-id))
        (dbdat (dbfile:get-dbdat dbstruct run-id)))
;; 		   (newdb  (db:open-megatest-db path: (db:dbfile-path)
;; 						name: dbname)))
;; 	      ;; NOTE: pushing on the stack only happens AFTER the handle has been used
;; 	      ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
;; 	      newdb)
        (if (dbr:dbdat? dbdat)
          dbdat
;;           (stack-pop! (dbr:subdb-dbstack subdb)))
;; 	(db:open-db subdb run-id))) ;; )
          (dbfile:open-db *dbstruct-dbs* #f db:initialize-main-db)
        )
   )
)

(define-inline (db:generic-error-printout exn . message)
  (print-call-chain (current-error-port))
  (apply debug:print-error 0 *default-log-port* message)
  (debug:print-error 0 *default-log-port* "   params: " params
		     ", error: "     ((condition-property-accessor 'exn 'message)   exn)
		     ", arguments: " ((condition-property-accessor 'exn 'arguments) exn)

Modified tasks.scm from [19e9ab848e] to [b89ba1474e].

516
517
518
519
520
521
522
523

524
525
526
527
528
529
530
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530







-
+







			 param-key state-patt action-patt test-patt)))))

(define (tasks:find-task-queue-records dbstruct target run-name test-patt state-patt action-patt)
  ;; (handle-exceptions
  ;;  exn
  ;;  '()
  ;;  (sqlite3:first-row
  (let ((db (db:delay-if-busy (db:get-db dbstruct)))
  (let ((db (db:delay-if-busy (db:get-db dbstruct #f)))
	(res '()))
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! res (cons (cons a b) res)))
     db "SELECT id,action,owner,state,target,name,testpatt,keylock,params FROM tasks_queue 
           WHERE
              target = ? AND name = ? AND state LIKE ? AND action LIKE ? AND testpatt LIKE ?;"

Modified tests/simplerun/thebeginning.scm from [1a8187c724] to [f405496649].

50
51
52
53
54
55
56



50
51
52
53
54
55
56
57
58
59







+
+
+


;; *************** db.scm tests ****************


(define thisdbdat (db:open-db dbstruct #f))
(test #f #t (dbr:dbdat? thisdbdat))

(test #f #t (dbr:subdb? (db:get-db dbstruct #f)))
(test #f #t (dbr:subdb? (db:get-db dbstruct 1)))