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
;;    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)))
;;     (if (stack? (dbr:subdb-dbstack subdb))
;; 	(if (stack-empty? (dbr:subdb-dbstack subdb))
;; 	    (let* ((dbname (db:run-id->dbname 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)
;;           (stack-pop! (dbr:subdb-dbstack subdb)))
;; 	(db:open-db subdb run-id))) ;; )




(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)







|
|
<
<
|
<
<
<
|
|
<
|
>
>
>







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 dbstruct run-id) 
   (let* ((subdb (dbfile:get-subdb dbstruct run-id))


        (dbdat (dbfile:get-dbdat dbstruct run-id)))



        (if (dbr:dbdat? dbdat)
          dbdat

          (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
			 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)))
	(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 ?;"







|







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 #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





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


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










>
>
>
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)))