Overview
| Comment: | Missed a lambda in one of the db:with-db changes |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.63-stackdumpfix |
| Files: | files | file ages | folders |
| SHA1: |
8af566c47d6b1a8289a7d0e6b9b23eaf |
| User & Date: | mrwellan on 2017-01-09 10:58:33 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-01-09
| ||
| 14:54 | Added use of a stack for database handles for the /tmp db, converted few more cases to use db:with-db check-in: f84301a090 user: mrwellan tags: v1.63-stackdumpfix | |
| 10:58 | Missed a lambda in one of the db:with-db changes check-in: 8af566c47d user: mrwellan tags: v1.63-stackdumpfix | |
| 00:05 | Dropped threshold for parallel api requests to 25 but it isn't clear it helped. WARNING: earlier fix for iterated (ezsteps based) tests broke state/status handling!! check-in: 4bac47df23 user: matt tags: v1.63-stackdumpfix | |
Changes
Modified db.scm from [aec6f9bf31] to [514087b343].
| ︙ | ︙ | |||
2286 2287 2288 2289 2290 2291 2292 |
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (rmt:get-key-val-pairs run-id))
(kvalues (map cadr keyvals))
(keys (rmt:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
| > > > | | | | | | | | | | 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 |
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (rmt:get-key-val-pairs run-id))
(kvalues (map cadr keyvals))
(keys (rmt:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
(if (null? keyvals)
'()
(begin
(db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
(lambda (db)
(apply sqlite3:for-each-row
(lambda (id)
(set! prev-run-ids (cons id prev-run-ids)))
db
(conc "SELECT id FROM runs WHERE " qrystr " AND state != 'deleted' AND id != ?;")
(append kvalues (list run-id)))))
prev-run-ids)))))
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
|
| ︙ | ︙ | |||
2469 2470 2471 2472 2473 2474 2475 | ;; (define (db:delete-test-records dbstruct run-id test-id) (db:general-call dbstruct 'delete-test-step-records (list test-id)) (db:general-call dbstruct 'delete-test-data-records (list test-id)) (db:with-db dbstruct #f #f | > | | 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 |
;;
(define (db:delete-test-records dbstruct run-id test-id)
(db:general-call dbstruct 'delete-test-step-records (list test-id))
(db:general-call dbstruct 'delete-test-data-records (list test-id))
(db:with-db
dbstruct #f #f
(lambda (db)
(sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))))
;;
(define (db:delete-old-deleted-test-records dbstruct)
(let (;; (run-ids (db:get-all-run-ids dbstruct))
(targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
(db:with-db
dbstruct
|
| ︙ | ︙ |
Modified rmt.scm from [44222fead3] to [e2d5384f31].
| ︙ | ︙ | |||
199 200 201 202 203 204 205 |
(remote-conndat-set! *runremote* #f)
(remote-server-url-set! *runremote* #f)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 9.1")
(mutex-unlock! *rmt-mutex*)
(tasks:start-and-wait-for-server (tasks:open-db) 0 15)
(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))))))))
| | | | | | | | | | | | | | | | | | | < | 199 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 |
(remote-conndat-set! *runremote* #f)
(remote-server-url-set! *runremote* #f)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 9.1")
(mutex-unlock! *rmt-mutex*)
(tasks:start-and-wait-for-server (tasks:open-db) 0 15)
(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))))))))
;; (define (rmt:update-db-stats run-id rawcmd params duration)
;; (mutex-lock! *db-stats-mutex*)
;; (handle-exceptions
;; exn
;; (begin
;; (debug:print 0 *default-log-port* "WARNING: stats collection failed in update-db-stats")
;; (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (print "exn=" (condition->list exn))
;; #f) ;; if this fails we don't care, it is just stats
;; (let* ((cmd (conc "run-id=" run-id " " (if (eq? rawcmd 'general-call) (car params) rawcmd)))
;; (stat-vec (hash-table-ref/default *db-stats* cmd #f)))
;; (if (not (vector? stat-vec))
;; (let ((newvec (vector 0 0)))
;; (hash-table-set! *db-stats* cmd newvec)
;; (set! stat-vec newvec)))
;; (vector-set! stat-vec 0 (+ (vector-ref stat-vec 0) 1))
;; (vector-set! stat-vec 1 (+ (vector-ref stat-vec 1) duration))))
;; (mutex-unlock! *db-stats-mutex*))
(define (rmt:print-db-stats)
(let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
(debug:print 18 *default-log-port* "DB Stats\n========")
(debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
(for-each (lambda (cmd)
(let ((cmd-dat (hash-table-ref *db-stats* cmd)))
|
| ︙ | ︙ |