Overview
Comment: | added re-try exception handling to lock-queue |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.55 |
Files: | files | file ages | folders |
SHA1: |
f824fb4d79a979924a74c1f8a3666db0 |
User & Date: | matt on 2014-07-22 00:10:00 |
Other Links: | branch diff | manifest | tags |
Context
2014-07-22
| ||
10:11 | Changed KILLED status from FAIL to KILLED and treat INCOMPLETE as if it was COMPLETED check-in: a35313652a user: mrwellan tags: v1.55 | |
00:10 | added re-try exception handling to lock-queue check-in: f824fb4d79 user: matt tags: v1.55 | |
2014-07-21
| ||
17:06 | Added fix for corner case where no tests were runnable but the other conditions did not catch it. check-in: e5dba3e2c7 user: mrwellan tags: v1.55 | |
Changes
Modified lock-queue.scm from [a9f4c5425b] to [0b444a0bb7].
︙ | ︙ | |||
19 20 21 22 23 24 25 | (declare (uses common)) ;;====================================================================== ;; attempt to prevent overlapping updates of rollup files by queueing ;; update requests in an sqlite db ;;====================================================================== | | > > > > > > > | | | | | | | | > > > > > > > | | | | > > > > > > > | | | | | | | | | > > > > | | > > > > > > > | | | > > > > > > > | | > > > > > > > | | | | | | | | | | | | | | | | | | | | | | 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 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | (declare (uses common)) ;;====================================================================== ;; attempt to prevent overlapping updates of rollup files by queueing ;; update requests in an sqlite db ;;====================================================================== (define (lock-queue:open-db fname #!key (count 10)) (let* ((actualfname (conc fname ".lockdb")) (dbexists (file-exists? actualfname)) (db (sqlite3:open-database actualfname)) (handler (make-busy-timeout 136000))) (if dbexists db (begin (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:open-db fname count: (- count 1)) db)) (sqlite3:execute db "CREATE TABLE IF NOT EXISTS queue ( id INTEGER PRIMARY KEY, test_id INTEGER, start_time INTEGER, state TEXT, CONSTRAINT queue_constraint UNIQUE (test_id));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS runlocks ( id INTEGER PRIMARY KEY, test_id INTEGER, run_lock TEXT, CONSTRAINT runlock_constraint UNIQUE (run_lock));")))) (sqlite3:set-busy-handler! db handler) db)) (define (lock-queue:set-state db test-id newstate #!key (count 10)) (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:set-state db test-id newstate (- count 1)) #f)) (sqlite3:execute db "UPDATE queue SET state=? WHERE test_id=?;" newstate test-id))) (define (lock-queue:any-younger? db mystart test-id #!key (count 10)) (let ((res #f)) (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:any-younger? db mystart test-id count: (- count 1)) #f)) (sqlite3:for-each-row (lambda (tid) ;; Actually this should not be needed as mystart cannot be simultaneously less than and test-id same as (if (not (equal? tid test-id)) (set! res tid))) db "SELECT test_id FROM queue WHERE start_time > ?;" mystart) res))) (define (lock-queue:get-lock db test-id #!key (count 10)) (let ((res #f) (lckqry (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';")) (mklckqry (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');"))) (let ((result (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:get-lock db test-id count: (- count 1))) #f) (sqlite3:with-transaction db (lambda () (sqlite3:for-each-row (lambda (tid lockstate) (set! res (list tid lockstate))) lckqry) (if res (if (equal? (car res) test-id) #t ;; already have the lock #f) (begin (sqlite3:execute mklckqry test-id) ;; if no error handled then return #t for got the lock #t))))))) (sqlite3:finalize! lckqry) (sqlite3:finalize! mklckqry) result))) (define (lock-queue:release-lock fname test-id #!key (count 10)) (let ((db (lock-queue:open-db fname))) (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:release-lock fname test-id count: (- count 1)) #f)) (sqlite3:execute db "DELETE FROM runlocks WHERE test_id=?;" test-id) (sqlite3:finalize! db)))) (define (lock-queue:steal-lock db test-id #!key (count 10)) (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:steal-lock db test-id count: (- count 1)) #f)) (sqlite3:execute db "DELETE FROM runlocks WHERE run_lock='locked';")) (lock-queue:get-lock db test-it)) ;; returns #f if ok to skip the task ;; returns #t if ok to proceed with task ;; otherwise waits ;; (define (lock-queue:wait-turn fname test-id #!key (count 10)) (let ((db (lock-queue:open-db fname)) (mystart (current-seconds))) (handle-exceptions exn (begin (thread-sleep! 10) (if (> count 0) (lock-queue:wait-turn fname test-id count: (- count 1)) #f)) (sqlite3:execute db "INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');" test-id mystart) (thread-sleep! 1) ;; give other tests a chance to register (let ((result (let loop ((younger-waiting (lock-queue:any-younger? db mystart test-id))) (if younger-waiting (begin ;; no need for us to wait. mark in the lock queue db as skipping (lock-queue:set-state db test-id "skipping") #f) ;; let the calling process know that nothing needs to be done (if (lock-queue:get-lock db test-id) #t (if (> (- (current-seconds) mystart) 36000) ;; waited too long, steal the lock (lock-queue:steal-lock db test-id) (begin (thread-sleep! 1) (loop (lock-queue:any-younger? db mystart test-id))))))))) (sqlite3:finalize! db) result)))) ;; (use trace) ;; (trace lock-queue:get-lock lock-queue:release-lock lock-queue:wait-turn lock-queue:any-younger? lock-queue:set-state) |
tests/installall/config/megatest.config.dat became a regular file with contents [736a5da885].
tests/installall/config/runconfigs.config.dat became a regular file with contents [3b8f260acb].