Artifact
5f0ac4e80ee5c8b724386daacd2f0d2cbb842a93:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 33 2c 20 4d 61 74 74 68 65 77 20 6-2013, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 This file is par
0040: 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a 3b t of Megatest..;
0050: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
0060: 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 st is free softw
0070: 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 are: you can red
0080: 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 istribute it and
0090: 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 20 /or modify.;;
00a0: 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 it under the t
00b0: 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 erms of the GNU
00c0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
00d0: 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 icense as publis
00e0: 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 68 hed by.;; th
00f0: 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 e Free Software
0100: 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 Foundation, eith
0110: 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 er version 3 of
0120: 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a the License, or.
0130: 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 20 ;; (at your
0140: 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 option) any late
0150: 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b r version..;; .;
0160: 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 ; Megatest i
0170: 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e s distributed in
0180: 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 the hope that i
0190: 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c t will be useful
01a0: 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 54 ,.;; but WIT
01b0: 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 HOUT ANY WARRANT
01c0: 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 Y; without even
01d0: 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 the implied warr
01e0: 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 4d anty of.;; M
01f0: 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f ERCHANTABILITY o
0200: 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 r FITNESS FOR A
0210: 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f PARTICULAR PURPO
0220: 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b 20 SE. See the.;;
0230: 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 GNU General
0240: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 Public License f
0250: 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e or more details.
0260: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 20 .;; .;; You
0270: 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 should have rece
0280: 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 ived a copy of t
0290: 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 he GNU General P
02a0: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b 3b ublic License.;;
02b0: 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 20 along with
02c0: 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e 6f Megatest. If no
02d0: 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 t, see <http://w
02e0: 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e ww.gnu.org/licen
02f0: 73 65 73 2f 3e 2e 0a 3b 3b 0a 0a 28 75 73 65 20 ses/>..;;..(use
0300: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3
0310: 73 71 6c 69 74 65 33 3a 29 20 73 72 66 69 2d 31 sqlite3:) srfi-1
0320: 38 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 8)..(declare (un
0330: 69 74 20 6c 6f 63 6b 2d 71 75 65 75 65 29 29 0a it lock-queue)).
0340: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0350: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0360: 20 28 75 73 65 73 20 64 65 62 75 67 70 72 69 6e (uses debugprin
0370: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
0380: 65 73 20 74 61 73 6b 73 29 29 0a 28 64 65 63 6c es tasks)).(decl
0390: 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e are (uses common
03a0: 6d 6f 64 29 29 0a 0a 28 69 6d 70 6f 72 74 20 63 mod))..(import c
03b0: 6f 6d 6d 6f 6e 6d 6f 64 0a 09 64 65 62 75 67 70 ommonmod..debugp
03c0: 72 69 6e 74 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d rint)..;;=======
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
0410: 3b 3b 20 61 74 74 65 6d 70 74 20 74 6f 20 70 72 ;; attempt to pr
0420: 65 76 65 6e 74 20 6f 76 65 72 6c 61 70 70 69 6e event overlappin
0430: 67 20 75 70 64 61 74 65 73 20 6f 66 20 72 6f 6c g updates of rol
0440: 6c 75 70 20 66 69 6c 65 73 20 62 79 20 71 75 65 lup files by que
0450: 75 65 69 6e 67 0a 3b 3b 20 75 70 64 61 74 65 20 ueing.;; update
0460: 72 65 71 75 65 73 74 73 20 69 6e 20 61 6e 20 73 requests in an s
0470: 71 6c 69 74 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d qlite db.;;=====
0480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04c0: 3d 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d =..;;===========
04d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 64 ===========.;; d
0510: 62 20 72 65 63 6f 72 64 2c 20 3c 76 65 63 74 6f b record, <vecto
0520: 72 20 64 62 20 70 61 74 68 2d 74 6f 2d 64 62 3e r db path-to-db>
0530: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
0580: 6e 65 20 28 6d 61 6b 65 2d 6c 6f 63 6b 2d 71 75 ne (make-lock-qu
0590: 65 75 65 3a 64 62 2d 64 61 74 29 28 6d 61 6b 65 eue:db-dat)(make
05a0: 2d 76 65 63 74 6f 72 20 33 29 29 0a 28 64 65 66 -vector 3)).(def
05b0: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 6c 6f 63 6b ine-inline (lock
05c0: 2d 71 75 65 75 65 3a 64 62 2d 64 61 74 2d 67 65 -queue:db-dat-ge
05d0: 74 2d 64 62 20 20 20 20 20 20 20 20 76 65 63 29 t-db vec)
05e0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
05f0: 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 vec 0)).(define
0600: 2d 69 6e 6c 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 -inline (lock-qu
0610: 65 75 65 3a 64 62 2d 64 61 74 2d 67 65 74 2d 70 eue:db-dat-get-p
0620: 61 74 68 20 20 20 20 20 20 76 65 63 29 20 20 20 ath vec)
0630: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
0640: 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 1)).(define-in
0650: 6c 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 65 75 65 line (lock-queue
0660: 3a 64 62 2d 64 61 74 2d 73 65 74 2d 64 62 21 20 :db-dat-set-db!
0670: 20 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 vec val)(v
0680: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 ector-set! vec 0
0690: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 val)).(define-i
06a0: 6e 6c 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 65 75 nline (lock-queu
06b0: 65 3a 64 62 2d 64 61 74 2d 73 65 74 2d 70 61 74 e:db-dat-set-pat
06c0: 68 21 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 h! vec val)(
06d0: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
06e0: 31 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 1 val))..(define
06f0: 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 65 6c (lock-queue:del
0700: 65 74 65 2d 6c 6f 63 6b 2d 64 62 20 64 62 64 61 ete-lock-db dbda
0710: 74 29 0a 20 20 28 6c 65 74 20 28 28 66 6e 61 6d t). (let ((fnam
0720: 65 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 e (lock-queue:db
0730: 2d 64 61 74 2d 67 65 74 2d 70 61 74 68 20 64 62 -dat-get-path db
0740: 64 61 74 29 29 29 0a 20 20 20 20 28 73 79 73 74 dat))). (syst
0750: 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 66 20 em (conc "rm -f
0760: 22 20 66 6e 61 6d 65 20 22 2a 22 29 29 29 29 0a " fname "*")))).
0770: 0a 28 64 65 66 69 6e 65 20 28 6c 6f 63 6b 2d 71 .(define (lock-q
0780: 75 65 75 65 3a 6f 70 65 6e 2d 64 62 20 66 6e 61 ueue:open-db fna
0790: 6d 65 20 23 21 6b 65 79 20 28 63 6f 75 6e 74 20 me #!key (count
07a0: 31 30 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 10)). (let* ((a
07b0: 63 74 75 61 6c 66 6e 61 6d 65 20 28 63 6f 6e 63 ctualfname (conc
07c0: 20 66 6e 61 6d 65 20 22 2e 6c 6f 63 6b 64 62 22 fname ".lockdb"
07d0: 29 29 0a 09 20 28 64 62 65 78 69 73 74 73 20 28 )).. (dbexists (
07e0: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
07f0: 74 73 3f 20 61 63 74 75 61 6c 66 6e 61 6d 65 29 ts? actualfname)
0800: 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 28 73 ).. (db (s
0810: 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 qlite3:open-data
0820: 62 61 73 65 20 61 63 74 75 61 6c 66 6e 61 6d 65 base actualfname
0830: 29 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 28 )).. (handler (
0840: 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 make-busy-timeou
0850: 74 20 31 33 36 30 30 30 29 29 29 0a 20 20 20 20 t 136000))).
0860: 28 69 66 20 64 62 65 78 69 73 74 73 0a 09 28 76 (if dbexists..(v
0870: 65 63 74 6f 72 20 64 62 20 61 63 74 75 61 6c 66 ector db actualf
0880: 6e 61 6d 65 29 0a 09 28 62 65 67 69 6e 0a 09 20 name)..(begin..
0890: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
08a0: 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 20 ons.. exn..
08b0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 74 68 (begin.. (th
08c0: 72 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 0a read-sleep! 10).
08d0: 09 20 20 20 20 20 28 69 66 20 28 3e 20 63 6f 75 . (if (> cou
08e0: 6e 74 20 30 29 0a 09 09 20 28 6c 6f 63 6b 2d 71 nt 0)... (lock-q
08f0: 75 65 75 65 3a 6f 70 65 6e 2d 64 62 20 66 6e 61 ueue:open-db fna
0900: 6d 65 20 63 6f 75 6e 74 3a 20 28 2d 20 63 6f 75 me count: (- cou
0910: 6e 74 20 31 29 29 0a 09 09 20 28 76 65 63 74 6f nt 1))... (vecto
0920: 72 20 64 62 20 61 63 74 75 61 6c 66 6e 61 6d 65 r db actualfname
0930: 29 29 29 0a 09 20 20 20 28 73 71 6c 69 74 65 33 ))).. (sqlite3
0940: 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f :with-transactio
0950: 6e 0a 09 20 20 20 20 64 62 0a 09 20 20 20 20 28 n.. db.. (
0960: 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 lambda ()..
0970: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
0980: 65 20 0a 09 20 20 20 20 20 20 20 64 62 0a 09 20 e .. db..
0990: 20 20 20 20 20 20 22 43 52 45 41 54 45 20 54 41 "CREATE TA
09a0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
09b0: 53 20 71 75 65 75 65 20 28 0a 20 20 20 20 20 09 S queue (. .
09c0: 20 20 20 20 20 20 20 20 20 69 64 20 20 20 20 20 id
09d0: 20 20 20 20 49 4e 54 45 47 45 52 20 50 52 49 4d INTEGER PRIM
09e0: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY KEY,.
09f0: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
0a00: 64 20 20 20 20 49 4e 54 45 47 45 52 2c 0a 20 20 d INTEGER,.
0a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
0a20: 74 61 72 74 5f 74 69 6d 65 20 49 4e 54 45 47 45 tart_time INTEGE
0a30: 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 R,.
0a40: 20 20 20 20 73 74 61 74 65 20 20 20 20 20 20 54 state T
0a50: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
0a60: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
0a70: 20 71 75 65 75 65 5f 63 6f 6e 73 74 72 61 69 6e queue_constrain
0a80: 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f 69 t UNIQUE (test_i
0a90: 64 29 29 3b 22 29 0a 09 20 20 20 20 20 20 28 73 d));").. (s
0aa0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 0a 09 qlite3:execute..
0ab0: 20 20 20 20 20 20 20 64 62 0a 09 20 20 20 20 20 db..
0ac0: 20 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 "CREATE TABLE
0ad0: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 72 75 IF NOT EXISTS ru
0ae0: 6e 6c 6f 63 6b 73 20 28 0a 20 20 20 20 20 20 20 nlocks (.
0af0: 20 20 20 20 20 20 20 20 20 20 69 64 20 20 20 20 id
0b00: 20 20 20 20 20 49 4e 54 45 47 45 52 20 50 52 49 INTEGER PRI
0b10: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
0b20: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f test_
0b30: 69 64 20 20 20 20 49 4e 54 45 47 45 52 2c 0a 20 id INTEGER,.
0b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b50: 72 75 6e 5f 6c 6f 63 6b 20 20 20 54 45 58 54 2c run_lock TEXT,
0b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0b70: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 72 75 6e CONSTRAINT run
0b80: 6c 6f 63 6b 5f 63 6f 6e 73 74 72 61 69 6e 74 20 lock_constraint
0b90: 55 4e 49 51 55 45 20 28 72 75 6e 5f 6c 6f 63 6b UNIQUE (run_lock
0ba0: 29 29 3b 22 29 29 29 29 29 29 0a 20 20 20 20 28 ));")))))). (
0bb0: 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 sqlite3:set-busy
0bc0: 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 61 6e -handler! db han
0bd0: 64 6c 65 72 29 0a 20 20 20 20 28 76 65 63 74 6f dler). (vecto
0be0: 72 20 64 62 20 61 63 74 75 61 6c 66 6e 61 6d 65 r db actualfname
0bf0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 6f )))..(define (lo
0c00: 63 6b 2d 71 75 65 75 65 3a 73 65 74 2d 73 74 61 ck-queue:set-sta
0c10: 74 65 20 64 62 64 61 74 20 74 65 73 74 2d 69 64 te dbdat test-id
0c20: 20 6e 65 77 73 74 61 74 65 20 23 21 6b 65 79 20 newstate #!key
0c30: 28 72 65 6d 74 72 69 65 73 20 31 30 29 29 0a 20 (remtries 10)).
0c40: 20 28 74 61 73 6b 73 3a 77 61 69 74 2d 6f 6e 2d (tasks:wait-on-
0c50: 6a 6f 75 72 6e 61 6c 20 28 6c 6f 63 6b 2d 71 75 journal (lock-qu
0c60: 65 75 65 3a 64 62 2d 64 61 74 2d 67 65 74 2d 70 eue:db-dat-get-p
0c70: 61 74 68 20 64 62 64 61 74 29 20 31 32 30 30 29 ath dbdat) 1200)
0c80: 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
0c90: 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 tions. exn.
0ca0: 28 69 66 20 28 3e 20 72 65 6d 74 72 69 65 73 20 (if (> remtries
0cb0: 30 29 0a 20 20 20 20 20 20 20 28 62 65 67 69 6e 0). (begin
0cc0: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
0cd0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
0ce0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 65 ort* "WARNING: e
0cf0: 78 63 65 70 74 69 6f 6e 20 6f 6e 20 6c 6f 63 6b xception on lock
0d00: 2d 71 75 65 75 65 3a 73 65 74 2d 73 74 61 74 65 -queue:set-state
0d10: 2e 20 54 72 79 69 6e 67 20 61 67 61 69 6e 20 69 . Trying again i
0d20: 6e 20 33 30 20 73 65 63 6f 6e 64 73 2e 22 29 0a n 30 seconds.").
0d30: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 . (debug:print 0
0d40: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
0d50: 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 rt* " message: "
0d60: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
0d70: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
0d80: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
0d90: 6e 29 29 0a 09 20 28 74 68 72 65 61 64 2d 73 6c n)).. (thread-sl
0da0: 65 65 70 21 20 33 30 29 0a 09 20 28 6c 6f 63 6b eep! 30).. (lock
0db0: 2d 71 75 65 75 65 3a 73 65 74 2d 73 74 61 74 65 -queue:set-state
0dc0: 20 64 62 64 61 74 20 74 65 73 74 2d 69 64 20 6e dbdat test-id n
0dd0: 65 77 73 74 61 74 65 20 72 65 6d 74 72 69 65 73 ewstate remtries
0de0: 3a 20 28 2d 20 72 65 6d 74 72 69 65 73 20 31 29 : (- remtries 1)
0df0: 29 29 0a 20 20 20 20 20 20 20 28 62 65 67 69 6e )). (begin
0e00: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
0e10: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
0e20: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 -log-port* " Fai
0e30: 6c 65 64 20 74 6f 20 73 65 74 20 6c 6f 63 6b 20 led to set lock
0e40: 73 74 61 74 65 20 66 6f 72 20 74 65 73 74 20 77 state for test w
0e50: 69 74 68 20 69 64 20 22 20 74 65 73 74 2d 69 64 ith id " test-id
0e60: 20 22 2c 20 65 72 72 6f 72 3a 20 22 20 28 28 63 ", error: " ((c
0e70: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
0e80: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
0e90: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 20 22 'message) exn) "
0ea0: 2c 20 67 69 76 69 6e 67 20 75 70 2e 22 29 0a 09 , giving up.")..
0eb0: 20 23 66 29 29 0a 20 20 20 28 73 71 6c 69 74 65 #f)). (sqlite
0ec0: 33 3a 65 78 65 63 75 74 65 20 28 6c 6f 63 6b 2d 3:execute (lock-
0ed0: 71 75 65 75 65 3a 64 62 2d 64 61 74 2d 67 65 74 queue:db-dat-get
0ee0: 2d 64 62 20 64 62 64 61 74 29 20 22 55 50 44 41 -db dbdat) "UPDA
0ef0: 54 45 20 71 75 65 75 65 20 53 45 54 20 73 74 61 TE queue SET sta
0f00: 74 65 3d 3f 20 57 48 45 52 45 20 74 65 73 74 5f te=? WHERE test_
0f10: 69 64 3d 3f 3b 22 0a 09 09 20 20 20 20 6e 65 77 id=?;"... new
0f20: 73 74 61 74 65 0a 09 09 20 20 20 20 74 65 73 74 state... test
0f30: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
0f40: 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 61 6e 79 2d (lock-queue:any-
0f50: 79 6f 75 6e 67 65 72 3f 20 64 62 64 61 74 20 6d younger? dbdat m
0f60: 79 73 74 61 72 74 20 74 65 73 74 2d 69 64 20 23 ystart test-id #
0f70: 21 6b 65 79 20 28 72 65 6d 74 72 69 65 73 20 31 !key (remtries 1
0f80: 30 29 29 0a 20 20 3b 3b 20 6e 6f 20 6e 65 65 64 0)). ;; no need
0f90: 20 74 6f 20 77 61 69 74 20 6f 6e 20 6a 6f 75 72 to wait on jour
0fa0: 6e 61 6c 20 6f 6e 20 72 65 61 64 20 6f 6e 6c 79 nal on read only
0fb0: 20 71 75 65 72 69 65 73 0a 20 20 3b 3b 20 28 74 queries. ;; (t
0fc0: 61 73 6b 73 3a 77 61 69 74 2d 6f 6e 2d 6a 6f 75 asks:wait-on-jou
0fd0: 72 6e 61 6c 20 28 6c 6f 63 6b 2d 71 75 65 75 65 rnal (lock-queue
0fe0: 3a 64 62 2d 64 61 74 2d 67 65 74 2d 70 61 74 68 :db-dat-get-path
0ff0: 20 64 62 64 61 74 29 20 31 32 30 30 29 0a 20 20 dbdat) 1200).
1000: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
1010: 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 69 66 ns. exn. (if
1020: 20 28 3e 20 72 65 6d 74 72 69 65 73 20 30 29 0a (> remtries 0).
1030: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 (begin..
1040: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
1050: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1060: 2a 20 22 57 41 52 4e 49 4e 47 3a 20 65 78 63 65 * "WARNING: exce
1070: 70 74 69 6f 6e 20 6f 6e 20 6c 6f 63 6b 2d 71 75 ption on lock-qu
1080: 65 75 65 3a 61 6e 79 2d 79 6f 75 6e 67 65 72 2e eue:any-younger.
1090: 20 52 65 6d 6f 76 69 6e 67 20 6c 6f 63 6b 64 62 Removing lockdb
10a0: 20 61 6e 64 20 74 72 79 69 6e 67 20 61 67 61 69 and trying agai
10b0: 6e 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2e 22 n in 5 seconds."
10c0: 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ).. (debug:print
10d0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
10e0: 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a port* " message:
10f0: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
1100: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
1110: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
1120: 65 78 6e 29 29 0a 09 20 28 74 68 72 65 61 64 2d exn)).. (thread-
1130: 73 6c 65 65 70 21 20 35 29 0a 20 20 20 20 20 20 sleep! 5).
1140: 20 20 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 (lock-queue:d
1150: 65 6c 65 74 65 2d 6c 6f 63 6b 2d 64 62 20 64 62 elete-lock-db db
1160: 64 61 74 29 0a 09 20 28 6c 6f 63 6b 2d 71 75 65 dat).. (lock-que
1170: 75 65 3a 61 6e 79 2d 79 6f 75 6e 67 65 72 3f 20 ue:any-younger?
1180: 64 62 64 61 74 20 6d 79 73 74 61 72 74 20 74 65 dbdat mystart te
1190: 73 74 2d 69 64 20 72 65 6d 74 72 69 65 73 3a 20 st-id remtries:
11a0: 28 2d 20 72 65 6d 74 72 69 65 73 20 31 29 29 29 (- remtries 1)))
11b0: 0a 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
11c0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
11d0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
11e0: 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
11f0: 64 20 74 6f 20 66 69 6e 64 20 79 6f 75 6e 67 65 d to find younge
1200: 72 20 6c 6f 63 6b 73 20 66 6f 72 20 74 65 73 74 r locks for test
1210: 20 77 69 74 68 20 69 64 20 22 20 74 65 73 74 2d with id " test-
1220: 69 64 20 22 2c 20 65 72 72 6f 72 3a 20 22 20 28 id ", error: " (
1230: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
1240: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
1250: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
1260: 20 22 2c 20 67 69 76 69 6e 67 20 75 70 2e 22 29 ", giving up.")
1270: 0a 09 20 23 66 29 29 0a 20 20 20 28 6c 65 74 20 .. #f)). (let
1280: 28 28 72 65 73 20 23 66 29 29 0a 20 20 20 20 20 ((res #f)).
1290: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
12a0: 68 2d 72 6f 77 0a 20 20 20 20 20 20 28 6c 61 6d h-row. (lam
12b0: 62 64 61 20 28 74 69 64 29 0a 09 3b 3b 20 41 63 bda (tid)..;; Ac
12c0: 74 75 61 6c 6c 79 20 74 68 69 73 20 73 68 6f 75 tually this shou
12d0: 6c 64 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 ld not be needed
12e0: 20 61 73 20 6d 79 73 74 61 72 74 20 63 61 6e 6e as mystart cann
12f0: 6f 74 20 62 65 20 73 69 6d 75 6c 74 61 6e 65 6f ot be simultaneo
1300: 75 73 6c 79 20 6c 65 73 73 20 74 68 61 6e 20 61 usly less than a
1310: 6e 64 20 74 65 73 74 2d 69 64 20 73 61 6d 65 20 nd test-id same
1320: 61 73 20 0a 09 28 69 66 20 28 6e 6f 74 20 28 65 as ..(if (not (e
1330: 71 75 61 6c 3f 20 74 69 64 20 74 65 73 74 2d 69 qual? tid test-i
1340: 64 29 29 20 0a 09 20 20 20 20 28 73 65 74 21 20 d)) .. (set!
1350: 72 65 73 20 74 69 64 29 29 29 0a 20 20 20 20 20 res tid))).
1360: 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 2d (lock-queue:db-
1370: 64 61 74 2d 67 65 74 2d 64 62 20 64 62 64 61 74 dat-get-db dbdat
1380: 29 0a 20 20 20 20 20 20 22 53 45 4c 45 43 54 20 ). "SELECT
1390: 74 65 73 74 5f 69 64 20 46 52 4f 4d 20 71 75 65 test_id FROM que
13a0: 75 65 20 57 48 45 52 45 20 73 74 61 72 74 5f 74 ue WHERE start_t
13b0: 69 6d 65 20 3e 20 3f 3b 22 20 6d 79 73 74 61 72 ime > ?;" mystar
13c0: 74 29 0a 20 20 20 20 20 72 65 73 29 29 29 0a 0a t). res)))..
13d0: 28 64 65 66 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 (define (lock-qu
13e0: 65 75 65 3a 67 65 74 2d 6c 6f 63 6b 20 64 62 64 eue:get-lock dbd
13f0: 61 74 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 at test-id #!key
1400: 20 28 63 6f 75 6e 74 20 31 30 29 28 77 61 69 74 (count 10)(wait
1410: 69 6e 67 2d 6d 73 67 20 23 66 29 29 0a 20 20 28 ing-msg #f)). (
1420: 74 61 73 6b 73 3a 77 61 69 74 2d 6f 6e 2d 6a 6f tasks:wait-on-jo
1430: 75 72 6e 61 6c 20 28 6c 6f 63 6b 2d 71 75 65 75 urnal (lock-queu
1440: 65 3a 64 62 2d 64 61 74 2d 67 65 74 2d 70 61 74 e:db-dat-get-pat
1450: 68 20 64 62 64 61 74 29 20 31 32 30 30 20 72 65 h dbdat) 1200 re
1460: 6d 6f 76 65 3a 20 23 74 20 77 61 69 74 69 6e 67 move: #t waiting
1470: 2d 6d 73 67 3a 20 22 6c 6f 63 6b 2d 71 75 65 75 -msg: "lock-queu
1480: 65 3a 67 65 74 2d 6c 6f 63 6b 2c 20 77 61 69 74 e:get-lock, wait
1490: 69 6e 67 20 6f 6e 20 6a 6f 75 72 6e 61 6c 22 29 ing on journal")
14a0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 . (let* ((res
14b0: 20 20 20 20 20 23 66 29 0a 09 20 28 64 62 20 20 #f).. (db
14c0: 20 20 20 20 20 20 28 6c 6f 63 6b 2d 71 75 65 75 (lock-queu
14d0: 65 3a 64 62 2d 64 61 74 2d 67 65 74 2d 64 62 20 e:db-dat-get-db
14e0: 64 62 64 61 74 29 29 0a 09 20 28 6c 63 6b 71 72 dbdat)).. (lckqr
14f0: 79 20 20 20 20 28 73 71 6c 69 74 65 33 3a 70 72 y (sqlite3:pr
1500: 65 70 61 72 65 20 64 62 20 22 53 45 4c 45 43 54 epare db "SELECT
1510: 20 74 65 73 74 5f 69 64 2c 72 75 6e 5f 6c 6f 63 test_id,run_loc
1520: 6b 20 46 52 4f 4d 20 72 75 6e 6c 6f 63 6b 73 20 k FROM runlocks
1530: 57 48 45 52 45 20 72 75 6e 5f 6c 6f 63 6b 3d 27 WHERE run_lock='
1540: 6c 6f 63 6b 65 64 27 3b 22 29 29 0a 09 20 28 6d locked';")).. (m
1550: 6b 6c 63 6b 71 72 79 20 20 28 73 71 6c 69 74 65 klckqry (sqlite
1560: 33 3a 70 72 65 70 61 72 65 20 64 62 20 22 49 4e 3:prepare db "IN
1570: 53 45 52 54 20 49 4e 54 4f 20 72 75 6e 6c 6f 63 SERT INTO runloc
1580: 6b 73 20 28 74 65 73 74 5f 69 64 2c 72 75 6e 5f ks (test_id,run_
1590: 6c 6f 63 6b 29 20 56 41 4c 55 45 53 20 28 3f 2c lock) VALUES (?,
15a0: 27 6c 6f 63 6b 65 64 27 29 3b 22 29 29 29 0a 20 'locked');"))).
15b0: 20 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 (let ((result
15c0: 20 0a 09 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 .. (handle-ex
15d0: 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 20 65 78 ceptions.. ex
15e0: 6e 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 n.. (begin..
15f0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
1600: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
1610: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
1620: 20 66 61 69 6c 65 64 20 74 6f 20 67 65 74 20 71 failed to get q
1630: 75 65 75 65 20 6c 6f 63 6b 2e 20 52 65 6d 6f 76 ueue lock. Remov
1640: 69 6e 67 20 6c 6f 63 6b 20 64 62 20 61 6e 64 20 ing lock db and
1650: 72 65 74 75 72 6e 69 6e 67 20 66 61 69 6c 22 29 returning fail")
1660: 20 3b 3b 20 57 69 6c 6c 20 74 72 79 20 61 67 61 ;; Will try aga
1670: 69 6e 20 69 6e 20 61 20 66 65 77 20 73 65 63 6f in in a few seco
1680: 6e 64 73 22 29 0a 09 20 20 20 20 20 20 28 64 65 nds").. (de
1690: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
16a0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
16b0: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
16c0: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
16d0: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
16e0: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
16f0: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c (thread-sl
1700: 65 65 70 21 20 31 30 29 0a 09 20 20 20 20 20 20 eep! 10)..
1710: 3b 3b 20 28 69 66 20 28 3e 20 63 6f 75 6e 74 20 ;; (if (> count
1720: 30 29 09 0a 09 20 20 20 20 20 20 3b 3b 20 20 23 0)... ;; #
1730: 66 20 3b 3b 20 28 6c 6f 63 6b 2d 71 75 65 75 65 f ;; (lock-queue
1740: 3a 67 65 74 2d 6c 6f 63 6b 20 64 62 64 61 74 20 :get-lock dbdat
1750: 74 65 73 74 2d 69 64 20 63 6f 75 6e 74 3a 20 28 test-id count: (
1760: 2d 20 63 6f 75 6e 74 20 31 29 29 20 2d 20 67 69 - count 1)) - gi
1770: 76 65 20 75 70 20 6f 6e 20 72 65 74 72 69 65 73 ve up on retries
1780: 20 0a 09 20 20 20 20 20 20 3b 3b 20 28 62 65 67 .. ;; (beg
1790: 69 6e 20 3b 3b 20 6e 65 76 65 72 20 72 65 63 6f in ;; never reco
17a0: 76 65 72 65 64 2c 20 72 65 6d 6f 74 65 20 74 68 vered, remote th
17b0: 65 20 6c 6f 63 6b 20 66 69 6c 65 20 61 6e 64 20 e lock file and
17c0: 72 65 74 75 72 6e 20 23 66 2c 20 6e 6f 20 6c 6f return #f, no lo
17d0: 63 6b 20 6f 62 74 61 69 6e 65 64 0a 09 20 20 20 ck obtained..
17e0: 20 20 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 (lock-queue:d
17f0: 65 6c 65 74 65 2d 6c 6f 63 6b 2d 64 62 20 64 62 elete-lock-db db
1800: 64 61 74 29 0a 09 20 20 20 20 20 20 23 66 29 0a dat).. #f).
1810: 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 77 69 . (sqlite3:wi
1820: 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e 0a 09 th-transaction..
1830: 20 20 20 20 20 64 62 0a 09 20 20 20 20 20 28 6c db.. (l
1840: 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 ambda ()..
1850: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
1860: 63 68 2d 72 6f 77 20 28 6c 61 6d 62 64 61 20 28 ch-row (lambda (
1870: 74 69 64 20 6c 6f 63 6b 73 74 61 74 65 29 0a 09 tid lockstate)..
1880: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
1890: 72 65 73 20 28 6c 69 73 74 20 74 69 64 20 6c 6f res (list tid lo
18a0: 63 6b 73 74 61 74 65 29 29 29 0a 09 09 09 09 20 ckstate))).....
18b0: 20 20 20 20 6c 63 6b 71 72 79 29 0a 09 20 20 20 lckqry)..
18c0: 20 20 20 20 28 69 66 20 72 65 73 0a 09 09 20 20 (if res...
18d0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63 61 (if (equal? (ca
18e0: 72 20 72 65 73 29 20 74 65 73 74 2d 69 64 29 0a r res) test-id).
18f0: 09 09 20 20 20 20 20 20 20 23 74 20 3b 3b 20 61 .. #t ;; a
1900: 6c 72 65 61 64 79 20 68 61 76 65 20 74 68 65 20 lready have the
1910: 6c 6f 63 6b 0a 09 09 20 20 20 20 20 20 20 23 66 lock... #f
1920: 29 0a 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 )... (begin...
1930: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
1940: 65 63 75 74 65 20 6d 6b 6c 63 6b 71 72 79 20 74 ecute mklckqry t
1950: 65 73 74 2d 69 64 29 0a 09 09 20 20 20 20 20 3b est-id)... ;
1960: 3b 20 69 66 20 6e 6f 20 65 72 72 6f 72 20 68 61 ; if no error ha
1970: 6e 64 6c 65 64 20 74 68 65 6e 20 72 65 74 75 72 ndled then retur
1980: 6e 20 23 74 20 66 6f 72 20 67 6f 74 20 74 68 65 n #t for got the
1990: 20 6c 6f 63 6b 0a 09 09 20 20 20 20 20 23 74 29 lock... #t)
19a0: 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 73 71 )))))). (sq
19b0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
19c0: 6c 63 6b 71 72 79 29 0a 20 20 20 20 20 20 28 73 lckqry). (s
19d0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
19e0: 20 6d 6b 6c 63 6b 71 72 79 29 0a 20 20 20 20 20 mklckqry).
19f0: 20 72 65 73 75 6c 74 29 29 29 0a 0a 28 64 65 66 result)))..(def
1a00: 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a ine (lock-queue:
1a10: 72 65 6c 65 61 73 65 2d 6c 6f 63 6b 20 66 6e 61 release-lock fna
1a20: 6d 65 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 me test-id #!key
1a30: 20 28 63 6f 75 6e 74 20 31 30 29 29 0a 20 20 28 (count 10)). (
1a40: 6c 65 74 2a 20 28 28 64 62 64 61 74 20 28 6c 6f let* ((dbdat (lo
1a50: 63 6b 2d 71 75 65 75 65 3a 6f 70 65 6e 2d 64 62 ck-queue:open-db
1a60: 20 66 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 74 fname))). (t
1a70: 61 73 6b 73 3a 77 61 69 74 2d 6f 6e 2d 6a 6f 75 asks:wait-on-jou
1a80: 72 6e 61 6c 20 28 6c 6f 63 6b 2d 71 75 65 75 65 rnal (lock-queue
1a90: 3a 64 62 2d 64 61 74 2d 67 65 74 2d 70 61 74 68 :db-dat-get-path
1aa0: 20 64 62 64 61 74 29 20 31 32 30 30 20 22 6c 6f dbdat) 1200 "lo
1ab0: 63 6b 2d 71 75 65 75 65 3a 72 65 6c 65 61 73 65 ck-queue:release
1ac0: 2d 6c 6f 63 6b 3b 20 77 61 69 74 69 6e 67 20 6f -lock; waiting o
1ad0: 6e 20 6a 6f 75 72 6e 61 6c 22 29 0a 20 20 20 20 n journal").
1ae0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
1af0: 6e 73 0a 20 20 20 20 20 65 78 6e 0a 20 20 20 20 ns. exn.
1b00: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 28 (begin. (
1b10: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
1b20: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1b30: 20 22 57 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 "WARNING: Faile
1b40: 64 20 74 6f 20 72 65 6c 65 61 73 65 20 71 75 65 d to release que
1b50: 75 65 20 6c 6f 63 6b 2e 20 57 69 6c 6c 20 74 72 ue lock. Will tr
1b60: 79 20 61 67 61 69 6e 20 69 6e 20 66 65 77 20 73 y again in few s
1b70: 65 63 6f 6e 64 73 22 29 0a 20 20 20 20 20 20 20 econds").
1b80: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
1b90: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1ba0: 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 * " message: " (
1bb0: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
1bc0: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
1bd0: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
1be0: 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 64 ). (thread
1bf0: 2d 73 6c 65 65 70 21 20 28 2f 20 63 6f 75 6e 74 -sleep! (/ count
1c00: 20 31 30 29 29 0a 20 20 20 20 20 20 20 28 69 66 10)). (if
1c10: 20 28 3e 20 63 6f 75 6e 74 20 30 29 0a 09 20 20 (> count 0)..
1c20: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 73 (begin.. (s
1c30: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
1c40: 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 2d (lock-queue:db-
1c50: 64 61 74 2d 67 65 74 2d 64 62 20 64 62 64 61 74 dat-get-db dbdat
1c60: 29 29 0a 09 20 20 20 20 20 28 6c 6f 63 6b 2d 71 )).. (lock-q
1c70: 75 65 75 65 3a 72 65 6c 65 61 73 65 2d 6c 6f 63 ueue:release-loc
1c80: 6b 20 66 6e 61 6d 65 20 74 65 73 74 2d 69 64 20 k fname test-id
1c90: 63 6f 75 6e 74 3a 20 28 2d 20 63 6f 75 6e 74 20 count: (- count
1ca0: 31 29 29 29 0a 09 20 20 20 28 6c 65 74 20 28 28 1))).. (let ((
1cb0: 6a 6f 75 72 6e 61 6c 20 28 63 6f 6e 63 20 66 6e journal (conc fn
1cc0: 61 6d 65 20 22 2d 6a 6f 75 72 6e 61 6c 22 29 29 ame "-journal"))
1cd0: 29 0a 09 20 20 20 20 20 3b 3b 20 49 66 20 77 65 ).. ;; If we
1ce0: 27 76 65 20 74 72 69 65 64 20 74 65 6e 20 74 69 've tried ten ti
1cf0: 6d 65 73 20 61 6e 64 20 66 61 69 6c 65 64 20 74 mes and failed t
1d00: 68 65 72 65 20 69 73 20 61 20 73 65 72 69 6f 75 here is a seriou
1d10: 73 20 70 72 6f 62 6c 65 6d 0a 09 20 20 20 20 20 s problem..
1d20: 3b 3b 20 74 72 79 20 74 6f 20 72 65 6d 6f 76 65 ;; try to remove
1d30: 20 74 68 65 20 6c 6f 63 6b 20 64 62 20 61 6e 64 the lock db and
1d40: 20 61 6c 6c 6f 77 20 69 74 20 74 6f 20 62 65 20 allow it to be
1d50: 72 65 63 72 65 61 74 65 64 0a 09 20 20 20 20 20 recreated..
1d60: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
1d70: 6e 73 0a 09 20 20 20 20 20 20 65 78 6e 0a 09 20 ns.. exn..
1d80: 20 20 20 20 20 23 66 0a 09 20 20 20 20 20 20 28 #f.. (
1d90: 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d if (common:file-
1da0: 65 78 69 73 74 73 3f 20 6a 6f 75 72 6e 61 6c 29 exists? journal)
1db0: 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 6a 6f 75 (delete-file jou
1dc0: 72 6e 61 6c 29 29 0a 09 20 20 20 20 20 20 28 69 rnal)).. (i
1dd0: 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 f (common:file-e
1de0: 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 20 20 28 xists? fname) (
1df0: 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 6e 61 6d delete-file fnam
1e00: 65 29 29 0a 09 20 20 20 20 20 20 23 66 29 29 29 e)).. #f)))
1e10: 29 0a 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a ). (sqlite3:
1e20: 65 78 65 63 75 74 65 20 28 6c 6f 63 6b 2d 71 75 execute (lock-qu
1e30: 65 75 65 3a 64 62 2d 64 61 74 2d 67 65 74 2d 64 eue:db-dat-get-d
1e40: 62 20 64 62 64 61 74 29 20 22 44 45 4c 45 54 45 b dbdat) "DELETE
1e50: 20 46 52 4f 4d 20 72 75 6e 6c 6f 63 6b 73 20 57 FROM runlocks W
1e60: 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 3b 22 HERE test_id=?;"
1e70: 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20 28 test-id). (
1e80: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
1e90: 21 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 ! (lock-queue:db
1ea0: 2d 64 61 74 2d 67 65 74 2d 64 62 20 64 62 64 61 -dat-get-db dbda
1eb0: 74 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t)))))..(define
1ec0: 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 73 74 65 61 (lock-queue:stea
1ed0: 6c 2d 6c 6f 63 6b 20 64 62 64 61 74 20 74 65 73 l-lock dbdat tes
1ee0: 74 2d 69 64 20 23 21 6b 65 79 20 28 63 6f 75 6e t-id #!key (coun
1ef0: 74 20 31 30 29 29 0a 20 20 28 64 65 62 75 67 3a t 10)). (debug:
1f00: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
1f10: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1f20: 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 "Attempting to s
1f30: 74 65 61 6c 20 6c 6f 63 6b 20 61 74 20 22 20 28 teal lock at " (
1f40: 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 2d 64 61 lock-queue:db-da
1f50: 74 2d 67 65 74 2d 70 61 74 68 20 64 62 64 61 74 t-get-path dbdat
1f60: 29 29 0a 20 20 28 74 61 73 6b 73 3a 77 61 69 74 )). (tasks:wait
1f70: 2d 6f 6e 2d 6a 6f 75 72 6e 61 6c 20 28 6c 6f 63 -on-journal (loc
1f80: 6b 2d 71 75 65 75 65 3a 64 62 2d 64 61 74 2d 67 k-queue:db-dat-g
1f90: 65 74 2d 70 61 74 68 20 64 62 64 61 74 29 20 31 et-path dbdat) 1
1fa0: 32 30 30 20 22 6c 6f 63 6b 2d 71 75 65 75 65 3a 200 "lock-queue:
1fb0: 73 74 65 61 6c 2d 6c 6f 63 6b 3b 20 77 61 69 74 steal-lock; wait
1fc0: 69 6e 67 20 6f 6e 20 6a 6f 75 72 6e 61 6c 22 29 ing on journal")
1fd0: 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
1fe0: 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 tions. exn.
1ff0: 28 62 65 67 69 6e 0a 20 20 20 20 20 28 64 65 62 (begin. (deb
2000: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
2010: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
2020: 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 64 20 74 ARNING: Failed t
2030: 6f 20 73 74 65 61 6c 20 71 75 65 75 65 20 6c 6f o steal queue lo
2040: 63 6b 2e 20 57 69 6c 6c 20 74 72 79 20 61 67 61 ck. Will try aga
2050: 69 6e 20 69 6e 20 66 65 77 20 73 65 63 6f 6e 64 in in few second
2060: 73 22 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a s"). (debug:
2070: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
2080: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
2090: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
20a0: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
20b0: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
20c0: 61 67 65 29 20 65 78 6e 29 29 0a 20 20 20 20 20 age) exn)).
20d0: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 (thread-sleep! 1
20e0: 30 29 0a 20 20 20 20 20 28 69 66 20 28 3e 20 63 0). (if (> c
20f0: 6f 75 6e 74 20 30 29 0a 09 20 28 6c 6f 63 6b 2d ount 0).. (lock-
2100: 71 75 65 75 65 3a 73 74 65 61 6c 2d 6c 6f 63 6b queue:steal-lock
2110: 20 64 62 64 61 74 20 74 65 73 74 2d 69 64 20 63 dbdat test-id c
2120: 6f 75 6e 74 3a 20 28 2d 20 63 6f 75 6e 74 20 31 ount: (- count 1
2130: 29 29 0a 09 20 23 66 29 29 0a 20 20 20 28 73 71 )).. #f)). (sq
2140: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 28 6c lite3:execute (l
2150: 6f 63 6b 2d 71 75 65 75 65 3a 64 62 2d 64 61 74 ock-queue:db-dat
2160: 2d 67 65 74 2d 64 62 20 64 62 64 61 74 29 20 22 -get-db dbdat) "
2170: 44 45 4c 45 54 45 20 46 52 4f 4d 20 72 75 6e 6c DELETE FROM runl
2180: 6f 63 6b 73 20 57 48 45 52 45 20 72 75 6e 5f 6c ocks WHERE run_l
2190: 6f 63 6b 3d 27 6c 6f 63 6b 65 64 27 3b 22 29 29 ock='locked';"))
21a0: 0a 20 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 67 . (lock-queue:g
21b0: 65 74 2d 6c 6f 63 6b 20 64 62 64 61 74 20 74 65 et-lock dbdat te
21c0: 73 74 2d 69 74 29 29 0a 0a 3b 3b 20 72 65 74 75 st-it))..;; retu
21d0: 72 6e 73 20 23 66 20 69 66 20 6f 6b 20 74 6f 20 rns #f if ok to
21e0: 73 6b 69 70 20 74 68 65 20 74 61 73 6b 0a 3b 3b skip the task.;;
21f0: 20 72 65 74 75 72 6e 73 20 23 74 20 69 66 20 6f returns #t if o
2200: 6b 20 74 6f 20 70 72 6f 63 65 65 64 20 77 69 74 k to proceed wit
2210: 68 20 74 61 73 6b 0a 3b 3b 20 6f 74 68 65 72 77 h task.;; otherw
2220: 69 73 65 20 77 61 69 74 73 0a 3b 3b 0a 28 64 65 ise waits.;;.(de
2230: 66 69 6e 65 20 28 6c 6f 63 6b 2d 71 75 65 75 65 fine (lock-queue
2240: 3a 77 61 69 74 2d 74 75 72 6e 20 66 6e 61 6d 65 :wait-turn fname
2250: 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 28 test-id #!key (
2260: 63 6f 75 6e 74 20 31 30 29 28 77 61 69 74 69 6e count 10)(waitin
2270: 67 2d 6d 73 67 20 23 66 29 29 0a 20 20 28 6c 65 g-msg #f)). (le
2280: 74 2a 20 28 28 64 62 64 61 74 20 20 20 28 6c 6f t* ((dbdat (lo
2290: 63 6b 2d 71 75 65 75 65 3a 6f 70 65 6e 2d 64 62 ck-queue:open-db
22a0: 20 66 6e 61 6d 65 29 29 0a 09 20 28 6d 79 73 74 fname)).. (myst
22b0: 61 72 74 20 28 63 75 72 72 65 6e 74 2d 73 65 63 art (current-sec
22c0: 6f 6e 64 73 29 29 0a 09 20 28 64 62 20 20 20 20 onds)).. (db
22d0: 20 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 (lock-queue:db
22e0: 2d 64 61 74 2d 67 65 74 2d 64 62 20 64 62 64 61 -dat-get-db dbda
22f0: 74 29 29 29 0a 20 20 20 20 3b 3b 20 28 74 61 73 t))). ;; (tas
2300: 6b 73 3a 77 61 69 74 2d 6f 6e 2d 6a 6f 75 72 6e ks:wait-on-journ
2310: 61 6c 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 al (lock-queue:d
2320: 62 2d 64 61 74 2d 67 65 74 2d 70 61 74 68 20 64 b-dat-get-path d
2330: 62 64 61 74 29 20 31 32 30 30 20 77 61 69 74 69 bdat) 1200 waiti
2340: 6e 67 2d 6d 73 67 3a 20 22 6c 6f 63 6b 2d 71 75 ng-msg: "lock-qu
2350: 65 75 65 3a 77 61 69 74 2d 74 75 72 6e 3b 20 77 eue:wait-turn; w
2360: 61 69 74 69 6e 67 20 6f 6e 20 6a 6f 75 72 6e 61 aiting on journa
2370: 6c 20 66 69 6c 65 22 29 0a 20 20 20 20 28 68 61 l file"). (ha
2380: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
2390: 20 20 20 20 20 65 78 6e 0a 20 20 20 20 20 28 62 exn. (b
23a0: 65 67 69 6e 0a 20 20 20 20 20 20 20 28 64 65 62 egin. (deb
23b0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
23c0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
23d0: 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 64 20 74 ARNING: Failed t
23e0: 6f 20 66 69 6e 64 20 6f 75 74 20 69 66 20 69 74 o find out if it
23f0: 20 69 73 20 6f 6b 20 74 6f 20 73 6b 69 70 20 74 is ok to skip t
2400: 68 65 20 77 61 69 74 20 71 75 65 75 65 2e 20 57 he wait queue. W
2410: 69 6c 6c 20 74 72 79 20 61 67 61 69 6e 20 69 6e ill try again in
2420: 20 66 65 77 20 73 65 63 6f 6e 64 73 22 29 0a 20 few seconds").
2430: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2440: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
2450: 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 g-port* " messag
2460: 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e e: " ((condition
2470: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
2480: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
2490: 29 20 65 78 6e 29 29 0a 20 20 20 20 20 20 20 28 ) exn)). (
24a0: 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e print-call-chain
24b0: 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d (current-error-
24c0: 70 6f 72 74 29 29 0a 20 20 20 20 20 20 20 28 74 port)). (t
24d0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 hread-sleep! 10)
24e0: 0a 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 63 . (if (> c
24f0: 6f 75 6e 74 20 30 29 0a 09 20 20 20 28 62 65 67 ount 0).. (beg
2500: 69 6e 0a 09 20 20 20 20 20 28 73 71 6c 69 74 65 in.. (sqlite
2510: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
2520: 09 20 20 20 20 20 28 6c 6f 63 6b 2d 71 75 65 75 . (lock-queu
2530: 65 3a 77 61 69 74 2d 74 75 72 6e 20 66 6e 61 6d e:wait-turn fnam
2540: 65 20 74 65 73 74 2d 69 64 20 63 6f 75 6e 74 3a e test-id count:
2550: 20 28 2d 20 63 6f 75 6e 74 20 31 29 29 29 0a 09 (- count 1)))..
2560: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
2570: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
2580: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2590: 2a 20 22 47 69 76 69 6e 67 20 75 70 20 63 61 6c * "Giving up cal
25a0: 6c 73 20 74 6f 20 6c 6f 63 6b 2d 71 75 65 75 65 ls to lock-queue
25b0: 3a 77 61 69 74 2d 74 75 72 6e 20 66 6f 72 20 74 :wait-turn for t
25c0: 65 73 74 2d 69 64 20 22 20 74 65 73 74 2d 69 64 est-id " test-id
25d0: 20 22 20 61 74 20 70 61 74 68 20 22 20 66 6e 61 " at path " fna
25e0: 6d 65 20 22 2c 20 70 72 69 6e 74 69 6e 67 20 63 me ", printing c
25f0: 61 6c 6c 20 63 68 61 69 6e 22 29 0a 09 20 20 20 all chain")..
2600: 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 (print-call-ch
2610: 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 ain (current-err
2620: 6f 72 2d 70 6f 72 74 29 29 0a 09 20 20 20 20 20 or-port))..
2630: 23 66 29 29 29 0a 20 20 20 20 20 3b 3b 20 77 61 #f))). ;; wa
2640: 69 74 20 31 30 20 73 65 63 6f 6e 64 73 20 61 6e it 10 seconds an
2650: 64 20 74 68 65 6e 20 63 68 65 63 6b 20 74 6f 20 d then check to
2660: 73 65 65 20 69 66 20 73 6f 6d 65 6f 6e 65 20 69 see if someone i
2670: 73 20 61 6c 72 65 61 64 79 20 75 70 64 61 74 69 s already updati
2680: 6e 67 20 74 68 65 20 68 74 6d 6c 0a 20 20 20 20 ng the html.
2690: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
26a0: 31 30 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f 10). (if (no
26b0: 74 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 61 6e t (lock-queue:an
26c0: 79 2d 79 6f 75 6e 67 65 72 3f 20 64 62 64 61 74 y-younger? dbdat
26d0: 20 6d 79 73 74 61 72 74 20 74 65 73 74 2d 69 64 mystart test-id
26e0: 29 29 20 3b 3b 20 6e 6f 20 70 72 6f 63 65 73 73 )) ;; no process
26f0: 69 6e 67 20 69 6e 20 66 6c 69 67 68 74 2c 20 6d ing in flight, m
2700: 75 73 74 20 74 72 79 20 74 6f 20 73 74 61 72 74 ust try to start
2710: 20 70 72 6f 63 65 73 73 69 6e 67 0a 09 20 28 62 processing.. (b
2720: 65 67 69 6e 0a 09 20 20 20 28 74 61 73 6b 73 3a egin.. (tasks:
2730: 77 61 69 74 2d 6f 6e 2d 6a 6f 75 72 6e 61 6c 20 wait-on-journal
2740: 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 64 62 2d 64 (lock-queue:db-d
2750: 61 74 2d 67 65 74 2d 70 61 74 68 20 64 62 64 61 at-get-path dbda
2760: 74 29 20 31 32 30 30 20 77 61 69 74 69 6e 67 2d t) 1200 waiting-
2770: 6d 73 67 3a 20 22 6c 6f 63 6b 2d 71 75 65 75 65 msg: "lock-queue
2780: 3a 77 61 69 74 2d 74 75 72 6e 3b 20 77 61 69 74 :wait-turn; wait
2790: 69 6e 67 20 6f 6e 20 6a 6f 75 72 6e 61 6c 20 66 ing on journal f
27a0: 69 6c 65 22 29 0a 09 20 20 20 28 73 71 6c 69 74 ile").. (sqlit
27b0: 65 33 3a 65 78 65 63 75 74 65 0a 09 20 20 20 20 e3:execute..
27c0: 64 62 0a 09 20 20 20 20 22 49 4e 53 45 52 54 20 db.. "INSERT
27d0: 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 OR REPLACE INTO
27e0: 71 75 65 75 65 20 28 74 65 73 74 5f 69 64 2c 73 queue (test_id,s
27f0: 74 61 72 74 5f 74 69 6d 65 2c 73 74 61 74 65 29 tart_time,state)
2800: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 27 77 61 VALUES (?,?,'wa
2810: 69 74 69 6e 67 27 29 3b 22 0a 09 20 20 20 20 74 iting');".. t
2820: 65 73 74 2d 69 64 20 6d 79 73 74 61 72 74 29 0a est-id mystart).
2830: 09 20 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 . ;; (thread-s
2840: 6c 65 65 70 21 20 31 29 20 3b 3b 20 67 69 76 65 leep! 1) ;; give
2850: 20 6f 74 68 65 72 20 74 65 73 74 73 20 61 20 63 other tests a c
2860: 68 61 6e 63 65 20 74 6f 20 72 65 67 69 73 74 65 hance to registe
2870: 72 0a 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 r.. (let ((res
2880: 75 6c 74 20 0a 09 09 20 20 28 6c 65 74 20 6c 6f ult ... (let lo
2890: 6f 70 20 28 28 79 6f 75 6e 67 65 72 2d 77 61 69 op ((younger-wai
28a0: 74 69 6e 67 20 28 6c 6f 63 6b 2d 71 75 65 75 65 ting (lock-queue
28b0: 3a 61 6e 79 2d 79 6f 75 6e 67 65 72 3f 20 64 62 :any-younger? db
28c0: 64 61 74 20 6d 79 73 74 61 72 74 20 74 65 73 74 dat mystart test
28d0: 2d 69 64 29 29 29 0a 09 09 20 20 20 20 28 69 66 -id)))... (if
28e0: 20 79 6f 75 6e 67 65 72 2d 77 61 69 74 69 6e 67 younger-waiting
28f0: 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 20 ....(begin....
2900: 3b 3b 20 6e 6f 20 6e 65 65 64 20 66 6f 72 20 75 ;; no need for u
2910: 73 20 74 6f 20 77 61 69 74 2e 20 6d 61 72 6b 20 s to wait. mark
2920: 69 6e 20 74 68 65 20 6c 6f 63 6b 20 71 75 65 75 in the lock queu
2930: 65 20 64 62 20 61 73 20 73 6b 69 70 70 69 6e 67 e db as skipping
2940: 0a 09 09 09 20 20 3b 3b 20 6e 6f 20 70 6f 69 6e .... ;; no poin
2950: 74 20 69 6e 20 6d 61 72 6b 69 6e 67 20 61 6e 79 t in marking any
2960: 74 68 69 6e 67 20 69 6e 20 74 68 65 20 71 75 65 thing in the que
2970: 75 65 20 2d 20 73 69 6d 70 6c 79 20 6e 65 76 65 ue - simply neve
2980: 72 20 72 65 67 69 73 74 65 72 20 74 68 69 73 0a r register this.
2990: 09 09 09 20 20 3b 3b 20 74 65 73 74 20 61 73 20 ... ;; test as
29a0: 69 74 20 69 73 20 2a 63 6f 76 65 72 65 64 2a 20 it is *covered*
29b0: 62 79 20 61 20 70 72 65 76 69 6f 75 73 6c 79 20 by a previously
29c0: 73 74 61 72 74 65 64 20 75 70 64 61 74 65 20 74 started update t
29d0: 6f 20 74 68 65 20 68 74 6d 6c 20 66 69 6c 65 0a o the html file.
29e0: 09 09 09 20 20 3b 3b 20 28 6c 6f 63 6b 2d 71 75 ... ;; (lock-qu
29f0: 65 75 65 3a 73 65 74 2d 73 74 61 74 65 20 64 62 eue:set-state db
2a00: 64 61 74 20 74 65 73 74 2d 69 64 20 22 73 6b 69 dat test-id "ski
2a10: 70 70 69 6e 67 22 29 0a 09 09 09 20 20 23 66 29 pping").... #f)
2a20: 20 3b 3b 20 6c 65 74 20 74 68 65 20 63 61 6c 6c ;; let the call
2a30: 69 6e 67 20 70 72 6f 63 65 73 73 20 6b 6e 6f 77 ing process know
2a40: 20 74 68 61 74 20 6e 6f 74 68 69 6e 67 20 6e 65 that nothing ne
2a50: 65 64 73 20 74 6f 20 62 65 20 64 6f 6e 65 0a 09 eds to be done..
2a60: 09 09 28 69 66 20 28 6c 6f 63 6b 2d 71 75 65 75 ..(if (lock-queu
2a70: 65 3a 67 65 74 2d 6c 6f 63 6b 20 64 62 64 61 74 e:get-lock dbdat
2a80: 20 74 65 73 74 2d 69 64 29 0a 09 09 09 20 20 20 test-id)....
2a90: 20 23 74 0a 09 09 09 20 20 20 20 28 69 66 20 28 #t.... (if (
2aa0: 3e 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 > (- (current-se
2ab0: 63 6f 6e 64 73 29 20 6d 79 73 74 61 72 74 29 20 conds) mystart)
2ac0: 33 36 30 30 30 29 20 3b 3b 20 77 61 69 74 65 64 36000) ;; waited
2ad0: 20 74 6f 6f 20 6c 6f 6e 67 2c 20 73 74 65 61 6c too long, steal
2ae0: 20 74 68 65 20 6c 6f 63 6b 0a 09 09 09 09 28 6c the lock.....(l
2af0: 6f 63 6b 2d 71 75 65 75 65 3a 73 74 65 61 6c 2d ock-queue:steal-
2b00: 6c 6f 63 6b 20 64 62 64 61 74 20 74 65 73 74 2d lock dbdat test-
2b10: 69 64 29 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 id).....(begin..
2b20: 09 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 ... (thread-sle
2b30: 65 70 21 20 31 29 0a 09 09 09 09 20 20 28 6c 6f ep! 1)..... (lo
2b40: 6f 70 20 28 6c 6f 63 6b 2d 71 75 65 75 65 3a 61 op (lock-queue:a
2b50: 6e 79 2d 79 6f 75 6e 67 65 72 3f 20 64 62 64 61 ny-younger? dbda
2b60: 74 20 6d 79 73 74 61 72 74 20 74 65 73 74 2d 69 t mystart test-i
2b70: 64 29 29 29 29 29 29 29 29 29 0a 09 20 20 20 20 d)))))))))..
2b80: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
2b90: 7a 65 21 20 64 62 29 0a 09 20 20 20 20 20 72 65 ze! db).. re
2ba0: 73 75 6c 74 29 29 29 29 29 29 0a 09 20 20 0a 20 sult)))))).. .
2bb0: 20 20 20 20 20 20 20 20 20 20 20 0a 3b 3b 20 28 .;; (
2bc0: 75 73 65 20 74 72 61 63 65 29 0a 3b 3b 20 28 74 use trace).;; (t
2bd0: 72 61 63 65 20 6c 6f 63 6b 2d 71 75 65 75 65 3a race lock-queue:
2be0: 67 65 74 2d 6c 6f 63 6b 20 6c 6f 63 6b 2d 71 75 get-lock lock-qu
2bf0: 65 75 65 3a 72 65 6c 65 61 73 65 2d 6c 6f 63 6b eue:release-lock
2c00: 20 6c 6f 63 6b 2d 71 75 65 75 65 3a 77 61 69 74 lock-queue:wait
2c10: 2d 74 75 72 6e 20 6c 6f 63 6b 2d 71 75 65 75 65 -turn lock-queue
2c20: 3a 61 6e 79 2d 79 6f 75 6e 67 65 72 3f 20 6c 6f :any-younger? lo
2c30: 63 6b 2d 71 75 65 75 65 3a 73 65 74 2d 73 74 61 ck-queue:set-sta
2c40: 74 65 29 0a te).