Artifact
c2c4883b3aa488cced707269c0130a0c6108802b:
0000: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f ==========.;; Co
0050: 70 79 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 pyright 2006-201
0060: 33 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 3, Matthew Wella
0070: 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 nd..;; .;; This
0080: 66 69 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 file is part of
0090: 4d 65 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b Megatest..;; .;;
00a0: 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 Megatest is
00b0: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 free software:
00c0: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 you can redistri
00d0: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d bute it and/or m
00e0: 6f 64 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 odify.;; it
00f0: 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 under the terms
0100: 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 of the GNU Gener
0110: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
0120: 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 e as published b
0130: 79 0a 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 y.;; the Fre
0140: 65 20 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 e Software Found
0150: 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 ation, either ve
0160: 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c rsion 3 of the L
0170: 69 63 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 icense, or.;;
0180: 20 20 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f (at your optio
0190: 6e 29 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 n) any later ver
01a0: 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 sion..;; .;;
01b0: 20 4d 65 67 61 74 65 73 74 20 69 73 20 64 69 73 Megatest is dis
01c0: 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 tributed in the
01d0: 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 69 6c hope that it wil
01e0: 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 l be useful,.;;
01f0: 20 20 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 but WITHOUT
0200: 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 ANY WARRANTY; wi
0210: 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 thout even the i
0220: 6d 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 mplied warranty
0230: 6f 66 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 of.;; MERCHA
0240: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0250: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0260: 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 CULAR PURPOSE.
0270: 53 65 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 See the.;; G
0280: 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 NU General Publi
0290: 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f c License for mo
02a0: 72 65 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a re details..;; .
02b0: 3b 3b 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c ;; You shoul
02c0: 64 20 68 61 76 65 20 72 65 63 65 69 76 65 64 20 d have received
02d0: 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e a copy of the GN
02e0: 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 U General Public
02f0: 20 4c 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 License.;;
0300: 61 6c 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 along with Megat
0310: 65 73 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 est. If not, se
0320: 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e e <http://www.gn
0330: 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e u.org/licenses/>
0340: 2e 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;.;;=========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
0390: 75 73 65 20 73 72 66 69 2d 36 39 20 70 6f 73 69 use srfi-69 posi
03a0: 78 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e x)..(declare (un
03b0: 69 74 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 it api)).(declar
03c0: 65 20 28 75 73 65 73 20 72 6d 74 29 29 0a 28 64 e (uses rmt)).(d
03d0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 eclare (uses db)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 64 62 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 dbmod)).(declar
0400: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 0a e (uses tasks)).
0410: 0a 28 69 6d 70 6f 72 74 20 64 62 6d 6f 64 29 0a .(import dbmod).
0420: 0a 3b 3b 20 61 6c 6c 6f 77 20 74 68 65 73 65 20 .;; allow these
0430: 71 75 65 72 69 65 73 20 74 68 72 6f 75 67 68 20 queries through
0440: 77 69 74 68 6f 75 74 20 73 74 61 72 74 69 6e 67 without starting
0450: 20 61 20 73 65 72 76 65 72 0a 3b 3b 0a 28 64 65 a server.;;.(de
0460: 66 69 6e 65 20 61 70 69 3a 72 65 61 64 2d 6f 6e fine api:read-on
0470: 6c 79 2d 71 75 65 72 69 65 73 0a 20 20 27 28 67 ly-queries. '(g
0480: 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 et-key-val-pairs
0490: 0a 20 20 20 20 67 65 74 2d 76 61 72 0a 20 20 20 . get-var.
04a0: 20 67 65 74 2d 6b 65 79 73 0a 20 20 20 20 67 65 get-keys. ge
04b0: 74 2d 6b 65 79 2d 76 61 6c 73 0a 20 20 20 20 74 t-key-vals. t
04c0: 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d est-toplevel-num
04d0: 2d 69 74 65 6d 73 0a 20 20 20 20 67 65 74 2d 74 -items. get-t
04e0: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a 20 est-info-by-id.
04f0: 20 20 20 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 get-steps-inf
0500: 6f 2d 62 79 2d 69 64 0a 20 20 20 20 67 65 74 2d o-by-id. get-
0510: 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a data-info-by-id.
0520: 20 20 20 20 74 65 73 74 2d 67 65 74 2d 72 75 6e test-get-run
0530: 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 dir-from-test-id
0540: 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 . get-count-t
0550: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
0560: 2d 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 67 65 -testname. ge
0570: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
0580: 6e 6e 69 6e 67 0a 20 20 20 20 67 65 74 2d 63 6f nning. get-co
0590: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
05a0: 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 0a 20 20 g-in-jobgroup.
05b0: 20 20 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 get-previous-t
05c0: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 0a 20 est-run-record.
05d0: 20 20 20 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d get-matching-
05e0: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
05f0: 6e 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 74 65 n-records. te
0600: 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 st-get-logfile-i
0610: 6e 66 6f 0a 20 20 20 20 74 65 73 74 2d 67 65 74 nfo. test-get
0620: 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 -records-for-ind
0630: 65 78 2d 66 69 6c 65 0a 20 20 20 20 67 65 74 2d ex-file. get-
0640: 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 testinfo-state-s
0650: 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 2d 67 tatus. test-g
0660: 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 et-top-process-p
0670: 69 64 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d id. test-get-
0680: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b paths-matching-k
0690: 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e eynames-target-n
06a0: 65 77 0a 20 20 20 20 67 65 74 2d 70 72 65 72 65 ew. get-prere
06b0: 71 73 2d 6e 6f 74 2d 6d 65 74 0a 20 20 20 20 67 qs-not-met. g
06c0: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
06d0: 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 unning-for-run-i
06e0: 64 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 69 6e d. get-run-in
06f0: 66 6f 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 73 fo. get-run-s
0700: 74 61 74 75 73 0a 20 20 20 20 67 65 74 2d 72 75 tatus. get-ru
0710: 6e 2d 73 74 61 74 65 0a 20 20 20 20 67 65 74 2d n-state. get-
0720: 72 75 6e 2d 73 74 61 74 73 0a 20 20 20 20 67 65 run-stats. ge
0730: 74 2d 72 75 6e 2d 74 69 6d 65 73 0a 20 20 20 20 t-run-times.
0740: 67 65 74 2d 74 61 72 67 65 74 73 0a 20 20 20 20 get-targets.
0750: 67 65 74 2d 74 61 72 67 65 74 0a 20 20 20 20 3b get-target. ;
0760: 3b 20 72 65 67 69 73 74 65 72 2d 72 75 6e 0a 20 ; register-run.
0770: 20 20 20 67 65 74 2d 74 65 73 74 73 2d 74 61 67 get-tests-tag
0780: 73 0a 20 20 20 20 67 65 74 2d 74 65 73 74 2d 74 s. get-test-t
0790: 69 6d 65 73 0a 20 20 20 20 67 65 74 2d 74 65 73 imes. get-tes
07a0: 74 73 2d 66 6f 72 2d 72 75 6e 0a 20 20 20 20 67 ts-for-run. g
07b0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
07c0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 20 -state-status.
07d0: 20 20 67 65 74 2d 74 65 73 74 2d 69 64 0a 20 20 get-test-id.
07e0: 20 20 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d get-tests-for-
07f0: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 0a 20 20 20 runs-mindata.
0800: 20 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 get-tests-for-r
0810: 75 6e 2d 6d 69 6e 64 61 74 61 0a 20 20 20 20 67 un-mindata. g
0820: 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d et-run-name-from
0830: 2d 69 64 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 -id. get-runs
0840: 0a 20 20 20 20 73 69 6d 70 6c 65 2d 67 65 74 2d . simple-get-
0850: 72 75 6e 73 0a 20 20 20 20 67 65 74 2d 6e 75 6d runs. get-num
0860: 2d 72 75 6e 73 0a 20 20 20 20 67 65 74 2d 72 75 -runs. get-ru
0870: 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 0a 20 ns-cnt-by-patt.
0880: 20 20 20 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 get-all-run-i
0890: 64 73 0a 20 20 20 20 67 65 74 2d 70 72 65 76 2d ds. get-prev-
08a0: 72 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 74 2d run-ids. get-
08b0: 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 run-ids-matching
08c0: 2d 74 61 72 67 65 74 0a 20 20 20 20 67 65 74 2d -target. get-
08d0: 72 75 6e 73 2d 62 79 2d 70 61 74 74 0a 20 20 20 runs-by-patt.
08e0: 20 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 0a get-steps-data.
08f0: 20 20 20 20 67 65 74 2d 73 74 65 70 73 2d 66 6f get-steps-fo
0900: 72 2d 74 65 73 74 0a 20 20 20 20 72 65 61 64 2d r-test. read-
0910: 74 65 73 74 2d 64 61 74 61 0a 20 20 20 20 72 65 test-data. re
0920: 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 61 72 ad-test-data-var
0930: 70 61 74 74 0a 20 20 20 20 6c 6f 67 69 6e 0a 20 patt. login.
0940: 20 20 20 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 tasks-get-las
0950: 74 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d 67 t. testmeta-g
0960: 65 74 2d 72 65 63 6f 72 64 0a 20 20 20 20 68 61 et-record. ha
0970: 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 0a ve-incompletes?.
0980: 20 20 20 20 3b 3b 20 73 79 6e 63 68 61 73 68 2d ;; synchash-
0990: 67 65 74 0a 20 20 20 20 67 65 74 2d 63 68 61 6e get. get-chan
09a0: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 0a 20 ged-record-ids.
09b0: 20 20 20 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 get-run-recor
09c0: 64 2d 69 64 73 20 0a 20 20 20 20 67 65 74 2d 6e d-ids . get-n
09d0: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
09e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 61 70 69 3a ))..(define api:
09f0: 77 72 69 74 65 2d 71 75 65 72 69 65 73 0a 20 20 write-queries.
0a00: 27 28 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 2d '(. get-keys-
0a10: 77 72 69 74 65 20 3b 3b 20 64 75 6d 6d 79 20 22 write ;; dummy "
0a20: 77 72 69 74 65 22 20 71 75 65 72 79 20 74 6f 20 write" query to
0a30: 66 6f 72 63 65 20 73 65 72 76 65 72 20 73 74 61 force server sta
0a40: 72 74 0a 0a 20 20 20 20 3b 3b 20 53 45 52 56 45 rt.. ;; SERVE
0a50: 52 53 0a 20 20 20 20 73 74 61 72 74 2d 73 65 72 RS. start-ser
0a60: 76 65 72 0a 20 20 20 20 6b 69 6c 6c 2d 73 65 72 ver. kill-ser
0a70: 76 65 72 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 ver.. ;; TEST
0a80: 53 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 73 S. test-set-s
0a90: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i
0aa0: 64 0a 20 20 20 20 64 65 6c 65 74 65 2d 74 65 73 d. delete-tes
0ab0: 74 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 64 65 t-records. de
0ac0: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
0ad0: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 0a 20 20 -test-records.
0ae0: 20 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 test-set-state
0af0: 2d 73 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 -status. test
0b00: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
0b10: 2d 70 69 64 0a 20 20 20 20 73 65 74 2d 73 74 61 -pid. set-sta
0b20: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
0b30: 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 ll-up-items.
0b40: 0a 20 20 20 20 75 70 64 61 74 65 2d 70 61 73 73 . update-pass
0b50: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 0a 20 20 20 -fail-counts.
0b60: 20 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 top-test-set-pe
0b70: 72 2d 70 66 2d 63 6f 75 6e 74 73 20 3b 3b 20 28 r-pf-counts ;; (
0b80: 64 62 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d db:top-test-set-
0b90: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 28 64 per-pf-counts (d
0ba0: 62 3a 67 65 74 2d 64 62 20 2a 64 62 2a 20 35 29 b:get-db *db* 5)
0bb0: 20 35 20 22 72 75 6e 66 69 72 73 74 22 29 0a 0a 5 "runfirst")..
0bc0: 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 ;; RUNS.
0bd0: 72 65 67 69 73 74 65 72 2d 72 75 6e 0a 20 20 20 register-run.
0be0: 20 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 set-tests-state
0bf0: 2d 73 74 61 74 75 73 0a 20 20 20 20 64 65 6c 65 -status. dele
0c00: 74 65 2d 72 75 6e 0a 20 20 20 20 6c 6f 63 6b 2f te-run. lock/
0c10: 75 6e 6c 6f 63 6b 2d 72 75 6e 0a 20 20 20 20 75 unlock-run. u
0c20: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
0c30: 74 69 6d 65 0a 20 20 20 20 6d 61 72 6b 2d 69 6e time. mark-in
0c40: 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 73 65 74 complete. set
0c50: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
0c60: 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 0a 20 20 d-roll-up-run.
0c70: 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 74 ;; STEPS. t
0c80: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
0c90: 75 73 21 0a 20 20 20 20 64 65 6c 65 74 65 2d 73 us!. delete-s
0ca0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 teps-for-test.
0cb0: 20 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 ;; TEST DATA.
0cc0: 20 20 20 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c test-data-rol
0cd0: 6c 75 70 0a 20 20 20 20 63 73 76 2d 3e 74 65 73 lup. csv->tes
0ce0: 74 2d 64 61 74 61 0a 0a 20 20 20 20 3b 3b 20 4d t-data.. ;; M
0cf0: 49 53 43 0a 20 20 20 20 73 79 6e 63 2d 69 6e 6d ISC. sync-inm
0d00: 65 6d 2d 3e 64 62 0a 20 20 20 20 64 72 6f 70 2d em->db. drop-
0d10: 61 6c 6c 2d 74 72 69 67 67 65 72 73 0a 20 20 20 all-triggers.
0d20: 20 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 create-all-trig
0d30: 67 65 72 73 0a 20 20 20 20 75 70 64 61 74 65 2d gers. update-
0d40: 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c tesdata-on-repil
0d50: 63 61 74 65 2d 64 62 20 0a 0a 20 20 20 20 3b 3b cate-db .. ;;
0d60: 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 74 65 TESTMETA. te
0d70: 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 stmeta-add-recor
0d80: 64 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d 75 d. testmeta-u
0d90: 70 64 61 74 65 2d 66 69 65 6c 64 0a 0a 20 20 20 pdate-field..
0da0: 20 3b 3b 20 54 41 53 4b 53 0a 20 20 20 20 74 61 ;; TASKS. ta
0db0: 73 6b 73 2d 61 64 64 0a 20 20 20 20 74 61 73 6b sks-add. task
0dc0: 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 76 65 s-set-state-give
0dd0: 6e 2d 70 61 72 61 6d 2d 6b 65 79 0a 20 20 20 20 n-param-key.
0de0: 29 29 0a 0a 3b 3b 20 54 68 65 73 65 20 61 72 65 ))..;; These are
0df0: 20 63 61 6c 6c 65 64 20 62 79 20 74 68 65 20 73 called by the s
0e00: 65 72 76 65 72 20 6f 6e 20 72 65 63 69 70 74 20 erver on recipt
0e10: 6f 66 20 2f 61 70 69 20 63 61 6c 6c 73 0a 3b 3b of /api calls.;;
0e20: 20 20 20 20 2d 20 6b 65 65 70 20 69 74 20 73 69 - keep it si
0e30: 6d 70 6c 65 2c 20 6f 6e 6c 79 20 72 65 74 75 72 mple, only retur
0e40: 6e 20 74 68 65 20 61 63 74 75 61 6c 20 72 65 73 n the actual res
0e50: 75 6c 74 20 6f 66 20 74 68 65 20 63 61 6c 6c 2c ult of the call,
0e60: 20 69 2e 65 2e 20 6e 6f 20 6d 65 74 61 20 69 6e i.e. no meta in
0e70: 66 6f 20 68 65 72 65 0a 3b 3b 0a 3b 3b 20 20 20 fo here.;;.;;
0e80: 20 2d 20 72 65 74 75 72 6e 73 20 23 28 20 66 6c - returns #( fl
0e90: 61 67 20 72 65 73 75 6c 74 20 29 0a 3b 3b 0a 28 ag result ).;;.(
0ea0: 64 65 66 69 6e 65 20 28 61 70 69 3a 65 78 65 63 define (api:exec
0eb0: 75 74 65 2d 72 65 71 75 65 73 74 73 20 64 62 73 ute-requests dbs
0ec0: 74 72 75 63 74 20 64 61 74 29 0a 20 20 28 68 61 truct dat). (ha
0ed0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
0ee0: 20 20 20 65 78 6e 0a 20 20 20 28 6c 65 74 20 28 exn. (let (
0ef0: 28 63 61 6c 6c 2d 63 68 61 69 6e 20 28 67 65 74 (call-chain (get
0f00: 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 29 29 0a 20 -call-chain))).
0f10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0f20: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
0f30: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
0f40: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
0f50: 65 73 74 73 20 72 65 63 65 69 76 65 64 20 61 6e ests received an
0f60: 20 65 78 63 65 70 74 69 6f 6e 20 66 72 6f 6d 20 exception from
0f70: 70 65 65 72 2c 20 64 61 74 3d 22 20 64 61 74 20 peer, dat=" dat
0f80: 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a 20 20 ", exn=" exn).
0f90: 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 (print-call-c
0fa0: 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 hain (current-er
0fb0: 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 ror-port)).
0fc0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
0fd0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0fe0: 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 * " message: "
0ff0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
1000: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
1010: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
1020: 29 29 20 20 20 20 20 20 20 0a 20 20 20 20 20 28 )) . (
1030: 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 74 6f vector #f (vecto
1040: 72 20 65 78 6e 20 63 61 6c 6c 2d 63 68 61 69 6e r exn call-chain
1050: 20 64 61 74 29 29 29 20 3b 3b 20 72 65 74 75 72 dat))) ;; retur
1060: 6e 20 73 6f 6d 65 20 73 74 75 66 66 20 66 6f 72 n some stuff for
1070: 20 64 65 62 75 67 20 69 66 20 61 6e 20 65 78 63 debug if an exc
1080: 65 70 74 69 6f 6e 20 68 61 70 70 65 6e 73 0a 20 eption happens.
1090: 20 20 28 63 6f 6e 64 0a 20 20 20 20 28 28 6e 6f (cond. ((no
10a0: 74 20 28 76 65 63 74 6f 72 3f 20 64 61 74 29 29 t (vector? dat))
10b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10c0: 20 20 20 20 3b 3b 20 69 74 20 69 73 20 61 6e 20 ;; it is an
10d0: 65 72 72 6f 72 20 74 6f 20 6e 6f 74 20 72 65 63 error to not rec
10e0: 65 69 76 65 20 61 20 76 65 63 74 6f 72 0a 20 20 eive a vector.
10f0: 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 (vector #f (v
1100: 65 63 74 6f 72 20 23 66 20 22 72 65 6d 6f 74 65 ector #f "remote
1110: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
1120: 77 69 74 68 20 61 20 76 65 63 74 6f 72 22 29 29 with a vector"))
1130: 29 0a 20 20 20 20 28 28 3e 20 2a 61 70 69 2d 70 ). ((> *api-p
1140: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
1150: 6f 75 6e 74 2a 20 32 30 29 20 3b 3b 20 32 30 29 ount* 20) ;; 20)
1160: 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
1170: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
1180: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
1190: 3a 20 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 : api:execute-re
11a0: 71 75 65 73 74 73 20 72 65 63 65 69 76 65 64 20 quests received
11b0: 61 6e 20 6f 76 65 72 6c 6f 61 64 65 64 20 6d 65 an overloaded me
11c0: 73 73 61 67 65 2e 22 29 0a 20 20 20 20 20 28 73 ssage."). (s
11d0: 65 74 21 20 2a 73 65 72 76 65 72 2d 6f 76 65 72 et! *server-over
11e0: 6c 6f 61 64 65 64 2a 20 23 74 29 0a 20 20 20 20 loaded* #t).
11f0: 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 (vector #f (vec
1200: 74 6f 72 20 23 66 20 27 6f 76 65 72 6c 6f 61 64 tor #f 'overload
1210: 65 64 29 29 29 20 3b 3b 20 74 68 65 20 69 6e 6e ed))) ;; the inn
1220: 65 72 20 76 65 63 74 6f 72 20 69 73 20 77 68 61 er vector is wha
1230: 74 20 67 65 74 73 20 72 65 74 75 72 6e 65 64 2e t gets returned.
1240: 20 6e 6f 70 65 2c 20 64 6f 6e 27 74 20 6b 6e 6f nope, don't kno
1250: 77 20 77 68 79 2e 20 70 6c 65 61 73 65 20 72 65 w why. please re
1260: 66 61 63 74 6f 72 21 0a 20 20 20 20 28 65 6c 73 factor!. (els
1270: 65 20 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 e . (let* (
1280: 28 63 6d 64 2d 69 6e 20 20 20 20 20 20 20 20 20 (cmd-in
1290: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 (vector-ref d
12a0: 61 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 at 0)).
12b0: 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
12c0: 20 20 20 20 20 20 28 69 66 20 28 73 79 6d 62 6f (if (symbo
12d0: 6c 3f 20 63 6d 64 2d 69 6e 29 0a 09 09 09 09 20 l? cmd-in).....
12e0: 20 20 63 6d 64 2d 69 6e 0a 09 09 09 09 20 20 20 cmd-in.....
12f0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
1300: 63 6d 64 2d 69 6e 29 29 29 0a 20 20 20 20 20 20 cmd-in))).
1310: 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 20 20 (params
1320: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
1330: 2d 72 65 66 20 64 61 74 20 31 29 29 0a 20 20 20 -ref dat 1)).
1340: 20 20 20 20 20 20 20 20 20 28 73 74 61 72 74 2d (start-
1350: 74 20 20 20 20 20 20 20 20 20 20 20 28 63 75 72 t (cur
1360: 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 rent-millisecond
1370: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
1380: 28 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 20 (readonly-mode
1390: 20 20 20 28 64 62 72 3a 64 62 73 74 72 75 63 74 (dbr:dbstruct
13a0: 2d 72 65 61 64 2d 6f 6e 6c 79 20 64 62 73 74 72 -read-only dbstr
13b0: 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 uct)).
13c0: 20 20 28 72 65 61 64 6f 6e 6c 79 2d 63 6f 6d 6d (readonly-comm
13d0: 61 6e 64 20 20 28 6d 65 6d 62 65 72 20 63 6d 64 and (member cmd
13e0: 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 api:read-only-q
13f0: 75 65 72 69 65 73 29 29 0a 20 20 20 20 20 20 20 ueries)).
1400: 20 20 20 20 20 28 77 72 69 74 65 63 6d 64 2d 69 (writecmd-i
1410: 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 n-readonly-mode
1420: 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 2d 6d 6f (and readonly-mo
1430: 64 65 20 28 6e 6f 74 20 72 65 61 64 6f 6e 6c 79 de (not readonly
1440: 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 20 20 20 20 -command))).
1450: 20 20 20 20 20 20 20 20 23 3b 28 66 6f 6f 20 20 #;(foo
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
1470: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
1480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1490: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c (common:tel
14a0: 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 emetry-log (conc
14b0: 20 22 61 70 69 2d 69 6e 3a 22 28 2d 3e 73 74 72 "api-in:"(->str
14c0: 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 20 ing cmd)).
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1500: 20 70 61 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 payload: `((par
1510: 61 6d 73 20 2e 20 2c 70 61 72 61 6d 73 29 29 29 ams . ,params)))
1520: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1540: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1560: 20 20 20 20 23 74 29 29 0a 20 20 20 20 20 20 20 #t)).
1570: 20 20 20 20 20 28 72 65 73 20 20 20 20 0a 20 20 (res .
1580: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 77 (if w
1590: 72 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f ritecmd-in-reado
15a0: 6e 6c 79 2d 6d 6f 64 65 0a 20 20 20 20 20 20 20 nly-mode.
15b0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 (conc
15c0: 22 61 74 74 65 6d 70 74 20 74 6f 20 72 75 6e 20 "attempt to run
15d0: 77 72 69 74 65 20 63 6f 6d 6d 61 6e 64 20 22 63 write command "c
15e0: 6d 64 22 20 6f 6e 20 61 20 72 65 61 64 2d 6f 6e md" on a read-on
15f0: 6c 79 20 64 61 74 61 62 61 73 65 22 29 0a 20 20 ly database").
1600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1610: 63 61 73 65 20 63 6d 64 0a 20 20 20 20 20 20 20 case cmd.
1620: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d ;;==
1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 =============.
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1670: 20 3b 3b 20 52 45 41 44 2f 57 52 49 54 45 20 51 ;; READ/WRITE Q
1680: 55 45 52 49 45 53 0a 20 20 20 20 20 20 20 20 20 UERIES.
1690: 20 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d ;;====
16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 20 20 ===========..
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e0: 28 28 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 ((get-keys-write
16f0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
1700: 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 (db:get
1710: 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 -keys dbstruct))
1720: 20 3b 3b 20 66 6f 72 63 65 20 61 20 64 75 6d 6d ;; force a dumm
1730: 79 20 22 77 72 69 74 65 22 20 71 75 65 72 79 20 y "write" query
1740: 74 6f 20 66 6f 72 63 65 20 73 65 72 76 65 72 3b to force server;
1750: 20 66 6f 72 20 64 65 62 75 67 20 69 6e 20 2d 72 for debug in -r
1760: 65 70 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 epl.
1770: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
1780: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 53 45 ;; SE
1790: 52 56 45 52 53 0a 20 20 20 20 20 20 20 20 20 20 RVERS.
17a0: 20 20 20 20 20 20 20 20 20 28 28 73 74 61 72 74 ((start
17b0: 2d 73 65 72 76 65 72 29 20 20 20 20 20 20 20 20 -server)
17c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
17d0: 6c 79 20 73 65 72 76 65 72 3a 6b 69 6e 64 2d 72 ly server:kind-r
17e0: 75 6e 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 un params)).
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1800: 28 6b 69 6c 6c 2d 73 65 72 76 65 72 29 20 20 20 (kill-server)
1810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1820: 20 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 2d (set! *server-
1830: 72 75 6e 2a 20 23 66 29 29 0a 0a 20 20 20 20 20 run* #f))..
1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1850: 20 54 45 53 54 53 0a 0a 20 20 20 20 20 20 20 20 TESTS..
1860: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 74 ;;((t
1870: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
1880: 61 74 75 73 2d 62 79 2d 69 64 29 20 20 20 20 20 atus-by-id)
1890: 28 61 70 70 6c 79 20 6d 74 3a 74 65 73 74 2d 73 (apply mt:test-s
18a0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
18b0: 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 by-id dbstruct p
18c0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
18d0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 42 42 20 ;;BB
18e0: 2d 20 63 6f 6d 6d 65 6e 74 65 64 20 6f 75 74 20 - commented out
18f0: 61 62 6f 76 65 20 62 65 63 61 75 73 65 20 69 74 above because it
1900: 20 77 61 73 20 63 61 6c 6c 69 6e 67 20 62 65 6c was calling bel
1910: 6f 77 2c 20 65 76 65 6e 74 75 61 6c 6c 79 2c 20 ow, eventually,
1920: 69 6e 63 6f 72 72 65 63 74 6c 79 20 28 64 62 73 incorrectly (dbs
1930: 74 72 75 63 74 20 70 61 73 73 65 64 20 74 6f 20 truct passed to
1940: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 mt:test-set-stat
1950: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 2c 20 e-status-by-id,
1960: 77 68 69 63 68 20 70 72 65 76 69 6f 73 6c 79 20 which previosly
1970: 64 69 64 20 6d 6f 72 65 2c 20 62 75 74 20 6e 6f did more, but no
1980: 77 20 6f 6e 6c 79 20 70 61 73 73 65 73 20 74 68 w only passes th
1990: 72 75 20 74 6f 20 64 62 3a 73 65 74 2d 73 74 61 ru to db:set-sta
19a0: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
19b0: 6c 6c 2d 75 70 2d 69 74 65 6d 73 2e 0a 20 20 20 ll-up-items..
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d0: 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 ((test-set-state
19e0: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 29 0a 0a -status-by-id)..
19f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a00: 20 20 20 20 3b 3b 20 28 64 65 66 69 6e 65 20 28 ;; (define (
1a10: 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 db:set-state-sta
1a20: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
1a30: 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 72 items dbstruct r
1a40: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
1a50: 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 20 item-path state
1a60: 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 0a status comment).
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a80: 20 20 20 20 28 64 62 3a 73 65 74 2d 73 74 61 74 (db:set-stat
1a90: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
1aa0: 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 20 l-up-items.
1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ac0: 64 62 73 74 72 75 63 74 0a 20 20 20 20 20 20 20 dbstruct.
1ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1ae0: 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 30 ist-ref params 0
1af0: 29 20 3b 20 72 75 6e 2d 69 64 0a 20 20 20 20 20 ) ; run-id.
1b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b10: 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 (list-ref params
1b20: 20 31 29 20 3b 20 74 65 73 74 2d 6e 61 6d 65 0a 1) ; test-name.
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b40: 20 20 20 20 20 23 66 20 20 20 20 20 20 20 20 20 #f
1b50: 20 20 20 20 20 20 20 20 20 3b 20 69 74 65 6d 2d ; item-
1b60: 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 path.
1b70: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d (list-
1b80: 72 65 66 20 70 61 72 61 6d 73 20 32 29 20 3b 20 ref params 2) ;
1b90: 73 74 61 74 65 0a 20 20 20 20 20 20 20 20 20 20 state.
1ba0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
1bb0: 2d 72 65 66 20 70 61 72 61 6d 73 20 33 29 20 3b -ref params 3) ;
1bc0: 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 status.
1bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
1be0: 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 34 29 st-ref params 4)
1bf0: 20 3b 20 63 6f 6d 6d 65 6e 74 0a 20 20 20 20 20 ; comment.
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1c20: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
1c30: 20 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 ((dele
1c40: 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 te-test-records)
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
1c60: 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 ply db:delete-te
1c70: 73 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 st-records dbstr
1c80: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ca0: 28 28 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c ((delete-old-del
1cb0: 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 eted-test-record
1cc0: 73 29 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c s) (apply db:del
1cd0: 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d ete-old-deleted-
1ce0: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 73 test-records dbs
1cf0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
1d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d10: 20 20 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 ((test-set-sta
1d20: 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 te-status)
1d30: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
1d40: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
1d50: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 atus dbstruct pa
1d60: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
1d70: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
1d80: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
1d90: 2d 70 69 64 29 20 20 20 20 20 20 20 20 28 61 70 -pid) (ap
1da0: 70 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74 2d ply db:test-set-
1db0: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 top-process-pid
1dc0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
1dd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1de0: 20 20 20 20 20 28 28 73 65 74 2d 73 74 61 74 65 ((set-state
1df0: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
1e00: 2d 75 70 2d 69 74 65 6d 73 29 20 28 61 70 70 6c -up-items) (appl
1e10: 79 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 y db:set-state-s
1e20: 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 tatus-and-roll-u
1e30: 70 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 p-items dbstruct
1e40: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
1e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s
1e60: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
1e70: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 29 and-roll-up-run)
1e80: 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 73 (apply db:set-s
1e90: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
1ea0: 72 6f 6c 6c 2d 75 70 2d 72 75 6e 20 64 62 73 74 roll-up-run dbst
1eb0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a 20 ruct params)) .
1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ed0: 20 20 28 28 74 6f 70 2d 74 65 73 74 2d 73 65 74 ((top-test-set
1ee0: 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 29 20 -per-pf-counts)
1ef0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
1f00: 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d op-test-set-per-
1f10: 70 66 2d 63 6f 75 6e 74 73 20 64 62 73 74 72 75 pf-counts dbstru
1f20: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1f40: 28 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 (test-set-archiv
1f50: 65 2d 62 6c 6f 63 6b 2d 69 64 29 20 20 20 20 20 e-block-id)
1f60: 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 (apply db:test
1f70: 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f -set-archive-blo
1f80: 63 6b 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 ck-id dbstruct p
1f90: 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 arams))..
1fa0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 ;; R
1fb0: 55 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 UNS.
1fc0: 20 20 20 20 20 20 20 28 28 72 65 67 69 73 74 65 ((registe
1fd0: 72 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 r-run)
1fe0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
1ff0: 3a 72 65 67 69 73 74 65 72 2d 72 75 6e 20 64 62 :register-run db
2000: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2020: 20 20 20 28 28 73 65 74 2d 74 65 73 74 73 2d 73 ((set-tests-s
2030: 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 tate-status)
2040: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 (apply db:set
2050: 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 -tests-state-sta
2060: 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 tus dbstruct par
2070: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2080: 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74 ((delet
2090: 65 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 e-run)
20a0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
20b0: 64 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 db:delete-run db
20c0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20e0: 20 20 20 28 28 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b ((lock/unlock
20f0: 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 -run)
2100: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6c 6f 63 (apply db:loc
2110: 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 64 62 73 k/unlock-run dbs
2120: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 28 28 75 70 64 61 74 65 2d 72 75 6e 2d 65 ((update-run-e
2150: 76 65 6e 74 5f 74 69 6d 65 29 20 20 20 20 20 20 vent_time)
2160: 20 20 28 61 70 70 6c 79 20 64 62 3a 75 70 64 61 (apply db:upda
2170: 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d te-run-event_tim
2180: 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d e dbstruct param
2190: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
21a0: 20 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d ((update-
21b0: 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 run-stats)
21c0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
21d0: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 :update-run-stat
21e0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
21f0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2200: 20 20 20 20 20 20 20 28 28 73 65 74 2d 76 61 72 ((set-var
2210: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2220: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2230: 3a 73 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 :set-var dbstruc
2240: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2260: 69 6e 63 2d 76 61 72 29 20 20 20 20 20 20 20 20 inc-var)
2270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2280: 70 70 6c 79 20 64 62 3a 69 6e 63 2d 76 61 72 20 pply db:inc-var
2290: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
22a0: 29 0a 09 09 20 20 20 28 28 64 65 63 2d 76 61 72 )... ((dec-var
22b0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
22c0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
22d0: 3a 64 65 63 2d 76 61 72 20 64 62 73 74 72 75 63 :dec-var dbstruc
22e0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2300: 64 65 6c 2d 76 61 72 29 20 20 20 20 20 20 20 20 del-var)
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2320: 70 70 6c 79 20 64 62 3a 64 65 6c 2d 76 61 72 20 pply db:del-var
2330: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2340: 29 0a 09 09 20 20 20 28 28 61 64 64 2d 76 61 72 )... ((add-var
2350: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2360: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2370: 3a 61 64 64 2d 76 61 72 20 64 62 73 74 72 75 63 :add-var dbstruc
2380: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
23a0: 3b 20 53 54 45 50 53 0a 20 20 20 20 20 20 20 20 ; STEPS.
23b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
23c0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
23d0: 21 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c !) (appl
23e0: 79 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 y db:teststep-se
23f0: 74 2d 73 74 61 74 75 73 21 20 64 62 73 74 72 75 t-status! dbstru
2400: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2420: 28 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f (delete-steps-fo
2430: 72 2d 74 65 73 74 21 29 20 20 20 20 20 20 20 20 r-test!)
2440: 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 (apply db:delete
2450: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 21 -steps-for-test!
2460: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2470: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2480: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
2490: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 53 ;; TES
24a0: 54 20 44 41 54 41 0a 20 20 20 20 20 20 20 20 20 T DATA.
24b0: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
24c0: 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 29 20 20 20 -data-rollup)
24d0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
24e0: 20 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f db:test-data-ro
24f0: 6c 6c 75 70 20 64 62 73 74 72 75 63 74 20 70 61 llup dbstruct pa
2500: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
2510: 20 20 20 20 20 20 20 20 20 20 28 28 63 73 76 2d ((csv-
2520: 3e 74 65 73 74 2d 64 61 74 61 29 20 20 20 20 20 >test-data)
2530: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
2540: 20 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 db:csv->test-da
2550: 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ta dbstruct para
2560: 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 ms))..
2570: 20 20 20 20 20 20 20 20 20 3b 3b 20 4d 49 53 43 ;; MISC
2580: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2590: 20 20 20 20 28 28 73 79 6e 63 2d 69 6e 6d 65 6d ((sync-inmem
25a0: 2d 3e 64 62 29 20 20 20 20 20 20 20 20 20 20 20 ->db)
25b0: 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 (let ((run-i
25c0: 64 20 28 63 61 72 20 70 61 72 61 6d 73 29 29 29 d (car params)))
25d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
25e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2600: 20 20 20 20 20 20 28 64 62 3a 73 79 6e 63 2d 74 (db:sync-t
2610: 6f 75 63 68 65 64 20 64 62 73 74 72 75 63 74 20 ouched dbstruct
2620: 72 75 6e 2d 69 64 20 66 6f 72 63 65 2d 73 79 6e run-id force-syn
2630: 63 3a 20 23 74 29 29 29 0a 20 20 20 20 20 20 20 c: #t))).
2640: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6d 61 ((ma
2650: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 29 20 20 rk-incomplete)
2660: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
2670: 6c 79 20 64 62 3a 66 69 6e 64 2d 61 6e 64 2d 6d ly db:find-and-m
2680: 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 64 ark-incomplete d
2690: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
26a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
26b0: 20 20 20 20 28 28 63 72 65 61 74 65 2d 61 6c 6c ((create-all
26c0: 2d 74 72 69 67 67 65 72 73 29 20 20 20 20 20 20 -triggers)
26d0: 20 20 20 20 28 64 62 3a 63 72 65 61 74 65 2d 61 (db:create-a
26e0: 6c 6c 2d 74 72 69 67 67 65 72 73 20 64 62 73 74 ll-triggers dbst
26f0: 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 ruct)).
2700: 20 20 20 20 20 20 20 20 20 20 28 28 64 72 6f 70 ((drop
2710: 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 20 20 -all-triggers)
2720: 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 64 72 (db:dr
2730: 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 20 op-all-triggers
2740: 64 62 73 74 72 75 63 74 29 29 20 0a 0a 20 20 20 dbstruct)) ..
2750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2760: 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 ;; TESTMETA.
2770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2780: 28 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 (testmeta-add-re
2790: 63 6f 72 64 29 20 20 20 20 20 20 20 28 61 70 70 cord) (app
27a0: 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d 61 ly db:testmeta-a
27b0: 64 64 2d 72 65 63 6f 72 64 20 64 62 73 74 72 75 dd-record dbstru
27c0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
27e0: 28 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 (testmeta-update
27f0: 2d 66 69 65 6c 64 29 20 20 20 20 20 28 61 70 70 -field) (app
2800: 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d 75 ly db:testmeta-u
2810: 70 64 61 74 65 2d 66 69 65 6c 64 20 64 62 73 74 pdate-field dbst
2820: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2840: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 74 61 67 ((get-tests-tag
2850: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 28 64 s) (d
2860: 62 3a 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 b:get-tests-tags
2870: 20 64 62 73 74 72 75 63 74 29 29 0a 0a 20 20 20 dbstruct))..
2880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2890: 3b 3b 20 54 41 53 4b 53 0a 20 20 20 20 20 20 20 ;; TASKS.
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 ((ta
28b0: 73 6b 73 2d 61 64 64 29 20 20 20 20 20 20 20 20 sks-add)
28c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
28d0: 74 61 73 6b 73 3a 61 64 64 20 64 62 73 74 72 75 tasks:add dbstru
28e0: 63 74 20 70 61 72 61 6d 73 29 29 20 20 20 0a 20 ct params)) .
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 20 20 28 28 74 61 73 6b 73 2d 73 65 74 2d 73 74 ((tasks-set-st
2910: 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d ate-given-param-
2920: 6b 65 79 29 20 28 61 70 70 6c 79 20 74 61 73 6b key) (apply task
2930: 73 3a 73 65 74 2d 73 74 61 74 65 2d 67 69 76 65 s:set-state-give
2940: 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 64 62 73 74 n-param-key dbst
2950: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
2960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2970: 20 28 28 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 ((tasks-get-las
2980: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 28 61 t) (a
2990: 70 70 6c 79 20 74 61 73 6b 73 3a 67 65 74 2d 6c pply tasks:get-l
29a0: 61 73 74 20 64 62 73 74 72 75 63 74 20 70 61 72 ast dbstruct par
29b0: 61 6d 73 29 29 0a 0a 09 09 20 20 20 3b 3b 20 4e ams)).... ;; N
29c0: 4f 20 53 59 4e 43 20 44 42 0a 09 09 20 20 20 28 O SYNC DB... (
29d0: 28 6e 6f 2d 73 79 6e 63 2d 73 65 74 29 20 20 20 (no-sync-set)
29e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
29f0: 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 73 65 ly db:no-sync-se
2a00: 74 20 20 20 20 20 20 20 20 20 2a 6e 6f 2d 73 79 t *no-sy
2a10: 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 0a nc-db* params)).
2a20: 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 67 .. ((no-sync-g
2a30: 65 74 2f 64 65 66 61 75 6c 74 29 20 20 20 20 20 et/default)
2a40: 20 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 (apply db:no-s
2a50: 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 ync-get/default
2a60: 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 *no-sync-db* par
2a70: 61 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f 2d ams))... ((no-
2a80: 73 79 6e 63 2d 64 65 6c 21 29 20 20 20 20 20 20 sync-del!)
2a90: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2aa0: 62 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 20 b:no-sync-del!
2ab0: 20 20 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 *no-sync-d
2ac0: 62 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 b* params))...
2ad0: 20 28 28 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c ((no-sync-get-l
2ae0: 6f 63 6b 29 20 20 20 20 20 20 20 20 20 20 28 61 ock) (a
2af0: 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d pply db:no-sync-
2b00: 67 65 74 2d 6c 6f 63 6b 20 20 20 20 2a 6e 6f 2d get-lock *no-
2b10: 73 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 sync-db* params)
2b20: 29 0a 09 09 20 20 20 0a 20 20 20 20 20 20 20 20 )... .
2b30: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 41 52 ;; AR
2b40: 43 48 49 56 45 53 0a 20 20 20 20 20 20 20 20 20 CHIVES.
2b50: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 61 ;; ((a
2b60: 72 63 68 69 76 65 2d 67 65 74 2d 61 6c 6c 6f 63 rchive-get-alloc
2b70: 61 74 69 6f 6e 73 29 20 20 20 0a 20 20 20 20 20 ations) .
2b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2b90: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
2ba0: 2d 64 69 73 6b 29 20 20 20 20 20 28 61 70 70 6c -disk) (appl
2bb0: 79 20 64 62 3a 61 72 63 68 69 76 65 2d 72 65 67 y db:archive-reg
2bc0: 69 73 74 65 72 2d 64 69 73 6b 20 64 62 73 74 72 ister-disk dbstr
2bd0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bf0: 28 28 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 ((archive-regist
2c00: 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 29 28 61 er-block-name)(a
2c10: 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76 65 2d pply db:archive-
2c20: 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e register-block-n
2c30: 61 6d 65 20 64 62 73 74 72 75 63 74 20 70 61 72 ame dbstruct par
2c40: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2c50: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 61 72 ;; ((ar
2c60: 63 68 69 76 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 chive-allocate-t
2c70: 65 73 74 73 75 69 74 65 2f 61 72 65 61 2d 74 6f estsuite/area-to
2c80: 2d 62 6c 6f 63 6b 29 28 61 70 70 6c 79 20 64 62 -block)(apply db
2c90: 3a 61 72 63 68 69 76 65 2d 61 6c 6c 6f 63 61 74 :archive-allocat
2ca0: 65 2d 74 65 73 74 73 75 69 74 65 2f 61 72 65 61 e-testsuite/area
2cb0: 2d 74 6f 2d 62 6c 6f 63 6b 20 64 62 73 74 72 75 -to-block dbstru
2cc0: 63 74 20 62 6c 6f 63 6b 2d 69 64 20 74 65 73 74 ct block-id test
2cd0: 73 75 69 74 65 2d 6e 61 6d 65 20 61 72 65 61 6b suite-name areak
2ce0: 65 79 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 ey))..
2cf0: 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d ;;=====
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d40: 3d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 =.
2d50: 20 20 20 20 20 3b 3b 20 52 45 41 44 20 4f 4e 4c ;; READ ONL
2d60: 59 20 51 55 45 52 49 45 53 0a 20 20 20 20 20 20 Y QUERIES.
2d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 3d ;;=
2d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2dc0: 3d 3d 3d 3d 3d 0a 0a 20 20 20 20 20 20 20 20 20 =====..
2dd0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4b 45 59 ;; KEY
2de0: 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 S.
2df0: 20 20 20 20 20 28 28 67 65 74 2d 6b 65 79 2d 76 ((get-key-v
2e00: 61 6c 2d 70 61 69 72 73 29 20 20 20 20 20 20 20 al-pairs)
2e10: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2e20: 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 b:get-key-val-pa
2e30: 69 72 73 20 64 62 73 74 72 75 63 74 20 70 61 72 irs dbstruct par
2e40: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2e50: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6b ((get-k
2e60: 65 79 73 29 20 20 20 20 20 20 20 20 20 20 20 20 eys)
2e70: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
2e80: 67 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 get-keys dbstruc
2e90: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
2ea0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 6b 65 79 ((get-key
2eb0: 2d 76 61 6c 73 29 20 20 20 20 20 20 20 20 20 20 -vals)
2ec0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
2ed0: 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 db:get-key-vals
2ee0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2ef0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2f00: 20 20 20 20 20 20 28 28 67 65 74 2d 74 61 72 67 ((get-targ
2f10: 65 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 et)
2f20: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2f30: 64 62 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 db:get-target db
2f40: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 20 20 20 28 28 67 65 74 2d 74 61 72 67 65 74 73 ((get-targets
2f70: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2f80: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 61 (db:get-ta
2f90: 72 67 65 74 73 20 64 62 73 74 72 75 63 74 29 29 rgets dbstruct))
2fa0: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2fb0: 20 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 ;; ARCHIVES
2fc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2fd0: 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 61 ((test-get-a
2fe0: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 rchive-block-inf
2ff0: 6f 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 o) (apply db
3000: 3a 74 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 :test-get-archiv
3010: 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 20 64 62 73 e-block-info dbs
3020: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3040: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3050: 20 20 20 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 ;; TESTS.
3060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3070: 20 20 28 28 74 65 73 74 2d 74 6f 70 6c 65 76 65 ((test-topleve
3080: 6c 2d 6e 75 6d 2d 69 74 65 6d 73 29 20 20 20 20 l-num-items)
3090: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
30a0: 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d est-toplevel-num
30b0: 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 -items dbstruct
30c0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
30d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
30e0: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
30f0: 64 29 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 d). (apply
3100: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 db:get-test-inf
3110: 6f 2d 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 o-by-id dbstruct
3120: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3130: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
3140: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 est-get-rundir-f
3150: 72 6f 6d 2d 74 65 73 74 2d 69 64 29 20 20 20 20 rom-test-id)
3160: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 (apply db:test-g
3170: 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 et-rundir-from-t
3180: 65 73 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 est-id dbstruct
3190: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
31a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
31b0: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
31c0: 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 nning-for-testna
31d0: 6d 65 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 me) (apply db:ge
31e0: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
31f0: 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 nning-for-testna
3200: 6d 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61 me dbstruct para
3210: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
3220: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f ((get-co
3230: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
3240: 67 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c g) (appl
3250: 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 y db:get-count-t
3260: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 64 62 73 ests-running dbs
3270: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3290: 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 ((get-count-te
32a0: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a sts-running-in-j
32b0: 6f 62 67 72 6f 75 70 29 20 28 61 70 70 6c 79 20 obgroup) (apply
32c0: 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 db:get-count-tes
32d0: 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f ts-running-in-jo
32e0: 62 67 72 6f 75 70 20 64 62 73 74 72 75 63 74 20 bgroup dbstruct
32f0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3300: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 ;; (
3310: 28 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 (delete-test-ste
3320: 70 2d 72 65 63 6f 72 64 73 29 20 20 20 20 20 20 p-records)
3330: 20 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 (apply db:dele
3340: 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 te-test-step-rec
3350: 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 70 61 ords dbstruct pa
3360: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3370: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 67 ;; ((g
3380: 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 et-previous-test
3390: 2d 72 75 6e 2d 72 65 63 6f 72 64 29 20 20 20 20 -run-record)
33a0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 (apply db:get-pr
33b0: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
33c0: 72 65 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 record dbstruct
33d0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
33e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
33f0: 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 t-matching-previ
3400: 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 ous-test-run-rec
3410: 6f 72 64 73 29 28 61 70 70 6c 79 20 64 62 3a 67 ords)(apply db:g
3420: 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 et-matching-prev
3430: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 ious-test-run-re
3440: 63 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 70 cords dbstruct p
3450: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3460: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
3470: 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e t-get-logfile-in
3480: 66 6f 29 20 20 20 20 20 20 20 20 20 20 20 28 61 fo) (a
3490: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 pply db:test-get
34a0: 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 64 62 -logfile-info db
34b0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 72 65 ((test-get-re
34e0: 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d cords-for-index-
34f0: 66 69 6c 65 29 20 20 28 61 70 70 6c 79 20 64 62 file) (apply db
3500: 3a 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 :test-get-record
3510: 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 s-for-index-file
3520: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3530: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3540: 20 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 ((get-test
3550: 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 info-state-statu
3560: 73 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 s) (apply
3570: 64 62 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d db:get-testinfo-
3580: 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 73 state-status dbs
3590: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
35a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35b0: 20 20 28 28 74 65 73 74 2d 67 65 74 2d 74 6f 70 ((test-get-top
35c0: 2d 70 72 6f 63 65 73 73 2d 70 69 64 29 20 20 20 -process-pid)
35d0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
35e0: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
35f0: 65 73 73 2d 70 69 64 20 64 62 73 74 72 75 63 74 ess-pid dbstruct
3600: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3610: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
3620: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
3630: 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d tching-keynames-
3640: 74 61 72 67 65 74 2d 6e 65 77 29 20 28 61 70 70 target-new) (app
3650: 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 ly db:test-get-p
3660: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 aths-matching-ke
3670: 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 ynames-target-ne
3680: 77 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d w dbstruct param
3690: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
36a0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 70 72 65 ((get-pre
36b0: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 20 20 20 reqs-not-met)
36c0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
36d0: 20 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d db:get-prereqs-
36e0: 6e 6f 74 2d 6d 65 74 20 64 62 73 74 72 75 63 74 not-met dbstruct
36f0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3700: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
3710: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
3720: 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 unning-for-run-i
3730: 64 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 d) (apply db:get
3740: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
3750: 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 ning-for-run-id
3760: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3770: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3780: 20 20 20 20 20 28 28 67 65 74 2d 6e 6f 74 2d 63 ((get-not-c
3790: 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 29 20 20 20 ompleted-cnt)
37a0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
37b0: 62 3a 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 b:get-not-comple
37c0: 74 65 64 2d 63 6e 74 20 20 64 62 73 74 72 75 63 ted-cnt dbstruc
37d0: 74 20 70 61 72 61 6d 73 29 29 20 0a 20 20 20 20 t params)) .
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
37f0: 3b 20 28 28 73 79 6e 63 68 61 73 68 2d 67 65 74 ; ((synchash-get
3800: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3810: 20 20 20 20 20 28 61 70 70 6c 79 20 73 79 6e 63 (apply sync
3820: 68 61 73 68 3a 73 65 72 76 65 72 2d 67 65 74 20 hash:server-get
3830: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3840: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3850: 20 20 20 20 20 28 28 67 65 74 2d 72 61 77 2d 72 ((get-raw-r
3860: 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 un-stats)
3870: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3880: 62 3a 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 b:get-raw-run-st
3890: 61 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72 ats dbstruct par
38a0: 61 6d 73 29 29 0a 09 09 20 20 20 28 28 67 65 74 ams))... ((get
38b0: 2d 74 65 73 74 2d 74 69 6d 65 73 29 20 20 20 20 -test-times)
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
38d0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 pply db:get-test
38e0: 2d 74 69 6d 65 73 20 64 62 73 74 72 75 63 74 20 -times dbstruct
38f0: 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 params))..
3900: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
3910: 52 55 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 RUNS.
3920: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 ((get-ru
3930: 6e 2d 69 6e 66 6f 29 20 20 20 20 20 20 20 20 20 n-info)
3940: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3950: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 b:get-run-info d
3960: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3980: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 73 74 ((get-run-st
3990: 61 74 75 73 29 20 20 20 20 20 20 20 20 20 20 20 atus)
39a0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
39b0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 64 62 73 t-run-status dbs
39c0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39e0: 20 20 28 28 67 65 74 2d 72 75 6e 2d 73 74 61 74 ((get-run-stat
39f0: 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e)
3a00: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3a10: 72 75 6e 2d 73 74 61 74 65 20 64 62 73 74 72 75 run-state dbstru
3a20: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3a40: 28 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 (set-run-status)
3a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3a60: 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 72 75 6e apply db:set-run
3a70: 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 74 -status dbstruct
3a80: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s
3aa0: 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 et-run-state-sta
3ab0: 74 75 73 29 20 20 09 09 09 20 28 61 70 70 6c 79 tus) ... (apply
3ac0: 20 64 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 db:set-run-stat
3ad0: 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 e-status dbstruc
3ae0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3b00: 75 70 64 61 74 65 2d 74 65 73 64 61 74 61 2d 6f update-tesdata-o
3b10: 6e 2d 72 65 70 69 6c 63 61 74 65 2d 64 62 29 20 n-repilcate-db)
3b20: 28 61 70 70 6c 79 20 64 62 3a 75 70 64 61 74 65 (apply db:update
3b30: 2d 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 -tesdata-on-repi
3b40: 6c 63 61 74 65 2d 64 62 20 20 64 62 73 74 72 75 lcate-db dbstru
3b50: 63 74 20 70 61 72 61 6d 73 29 29 20 0a 20 20 20 ct params)) .
3b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b70: 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d ((get-tests-for-
3b80: 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 run)
3b90: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 (apply db:get-te
3ba0: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 sts-for-run dbst
3bb0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bd0: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 ((get-tests-for
3be0: 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 -run-state-statu
3bf0: 73 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 s) (apply db:get
3c00: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 -tests-for-run-s
3c10: 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 tate-status dbst
3c20: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c40: 20 28 28 67 65 74 2d 74 65 73 74 2d 69 64 29 20 ((get-test-id)
3c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c60: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3c70: 65 73 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 est-id dbstruct
3c80: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3c90: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
3ca0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d t-tests-for-run-
3cb0: 6d 69 6e 64 61 74 61 29 20 20 20 20 28 61 70 70 mindata) (app
3cc0: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d ly db:get-tests-
3cd0: 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 for-run-mindata
3ce0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3cf0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3d00: 20 20 20 20 20 3b 3b 20 28 28 67 65 74 2d 74 65 ;; ((get-te
3d10: 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e sts-for-runs-min
3d20: 64 61 74 61 29 20 20 20 28 61 70 70 6c 79 20 64 data) (apply d
3d30: 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d b:get-tests-for-
3d40: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 64 62 73 runs-mindata dbs
3d50: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d70: 20 20 28 28 67 65 74 2d 72 75 6e 73 29 20 20 20 ((get-runs)
3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d90: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3da0: 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 70 61 runs dbstruct pa
3db0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3dc0: 20 20 20 20 20 20 20 20 20 20 28 28 73 69 6d 70 ((simp
3dd0: 6c 65 2d 67 65 74 2d 72 75 6e 73 29 20 20 20 20 le-get-runs)
3de0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
3df0: 20 64 62 3a 73 69 6d 70 6c 65 2d 67 65 74 2d 72 db:simple-get-r
3e00: 75 6e 73 20 64 62 73 74 72 75 63 74 20 70 61 72 uns dbstruct par
3e10: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
3e20: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6e ((get-n
3e30: 75 6d 2d 72 75 6e 73 29 20 20 20 20 20 20 20 20 um-runs)
3e40: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3e50: 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 db:get-num-runs
3e60: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3e70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3e80: 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 73 2d ((get-runs-
3e90: 63 6e 74 2d 62 79 2d 70 61 74 74 29 20 20 20 20 cnt-by-patt)
3ea0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
3eb0: 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 et-runs-cnt-by-p
3ec0: 61 74 74 20 64 62 73 74 72 75 63 74 20 70 61 72 att dbstruct par
3ed0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
3ee0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 61 ((get-a
3ef0: 6c 6c 2d 72 75 6e 2d 69 64 73 29 20 20 20 20 20 ll-run-ids)
3f00: 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 (db:get
3f10: 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 64 62 73 -all-run-ids dbs
3f20: 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 truct)).
3f30: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3f40: 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 20 -prev-run-ids)
3f50: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
3f60: 79 20 64 62 3a 67 65 74 2d 70 72 65 76 2d 72 75 y db:get-prev-ru
3f70: 6e 2d 69 64 73 20 64 62 73 74 72 75 63 74 20 70 n-ids dbstruct p
3f80: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3f90: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3fa0: 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e -run-ids-matchin
3fb0: 67 2d 74 61 72 67 65 74 29 20 20 28 61 70 70 6c g-target) (appl
3fc0: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 69 64 73 y db:get-run-ids
3fd0: 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 -matching-target
3fe0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3ff0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4000: 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 73 ((get-runs
4010: 2d 62 79 2d 70 61 74 74 29 20 20 20 20 20 20 20 -by-patt)
4020: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4030: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
4040: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
4050: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4060: 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d ((get-run-
4070: 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 29 20 20 20 name-from-id)
4080: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4090: 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f get-run-name-fro
40a0: 6d 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 m-id dbstruct pa
40b0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
40c0: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
40d0: 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 29 20 main-run-stats)
40e0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
40f0: 20 64 62 3a 67 65 74 2d 6d 61 69 6e 2d 72 75 6e db:get-main-run
4100: 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 74 20 -stats dbstruct
4110: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
4120: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
4130: 74 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 20 t-var)
4140: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
4150: 6c 79 20 64 62 3a 67 65 74 2d 76 61 72 20 64 62 ly db:get-var db
4160: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
4170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4180: 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 73 74 61 ((get-run-sta
4190: 74 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ts)
41a0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
41b0: 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 -run-stats dbstr
41c0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
41d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41e0: 28 28 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 29 ((get-run-times)
41f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4200: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 (apply db:get-ru
4210: 6e 2d 74 69 6d 65 73 20 64 62 73 74 72 75 63 74 n-times dbstruct
4220: 20 70 61 72 61 6d 73 29 29 20 0a 0a 20 20 20 20 params)) ..
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
4240: 3b 20 53 54 45 50 53 0a 20 20 20 20 20 20 20 20 ; STEPS.
4250: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
4260: 2d 73 74 65 70 73 2d 64 61 74 61 29 20 20 20 20 -steps-data)
4270: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
4280: 79 20 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 64 y db:get-steps-d
4290: 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 ata dbstruct par
42a0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
42b0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 73 ((get-s
42c0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 29 20 20 teps-for-test)
42d0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
42e0: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 db:get-steps-for
42f0: 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 20 70 -test dbstruct p
4300: 61 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 67 arams))... ((g
4310: 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 et-steps-info-by
4320: 2d 69 64 29 20 20 20 20 20 20 20 20 20 28 61 70 -id) (ap
4330: 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 65 70 73 ply db:get-steps
4340: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 -info-by-id dbst
4350: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 ruct params))..
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4370: 20 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 ;; TEST DATA.
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 20 20 28 28 72 65 61 64 2d 74 65 73 74 2d 64 61 ((read-test-da
43a0: 74 61 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ta)
43b0: 20 20 28 61 70 70 6c 79 20 64 62 3a 72 65 61 64 (apply db:read
43c0: 2d 74 65 73 74 2d 64 61 74 61 20 64 62 73 74 72 -test-data dbstr
43d0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 28 28 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 ((read-test-data
4400: 2d 76 61 72 70 61 74 74 29 20 20 20 20 20 20 20 -varpatt)
4410: 28 61 70 70 6c 79 20 64 62 3a 72 65 61 64 2d 74 (apply db:read-t
4420: 65 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74 74 est-data-varpatt
4430: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
4440: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4450: 20 20 20 20 20 20 28 28 67 65 74 2d 64 61 74 61 ((get-data
4460: 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 20 20 -info-by-id)
4470: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4480: 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 get-data-info-by
4490: 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 -id dbstruct par
44a0: 61 6d 73 29 29 20 0a 0a 20 20 20 20 20 20 20 20 ams)) ..
44b0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4d 49 ;; MI
44c0: 53 43 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 SC.
44d0: 20 20 20 20 20 20 28 28 67 65 74 2d 6c 61 74 65 ((get-late
44e0: 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 29 20 20 20 st-host-load)
44f0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4500: 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d get-latest-host-
4510: 6c 6f 61 64 20 64 62 73 74 72 75 63 74 20 70 61 load dbstruct pa
4520: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
4530: 20 20 20 20 20 20 20 20 20 20 28 28 68 61 76 65 ((have
4540: 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 29 20 20 -incompletes?)
4550: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
4560: 20 64 62 3a 68 61 76 65 2d 69 6e 63 6f 6d 70 6c db:have-incompl
4570: 65 74 65 73 3f 20 64 62 73 74 72 75 63 74 20 70 etes? dbstruct p
4580: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
4590: 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 6f 67 ((log
45a0: 69 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 20 in)
45b0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
45c0: 79 20 64 62 3a 6c 6f 67 69 6e 20 64 62 73 74 72 y db:login dbstr
45d0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45f0: 28 28 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 29 20 ((general-call)
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4610: 28 6c 65 74 20 28 28 73 74 6d 74 6e 61 6d 65 20 (let ((stmtname
4620: 20 20 28 63 61 72 20 70 61 72 61 6d 73 29 29 0a (car params)).
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4660: 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 (run-id
4670: 20 20 20 20 20 28 63 61 64 72 20 70 61 72 61 6d (cadr param
4680: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
46c0: 61 6c 70 61 72 61 6d 73 20 28 63 64 64 72 20 70 alparams (cddr p
46d0: 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 20 20 arams))).
46e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
4710: 62 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 b:general-call d
4720: 62 73 74 72 75 63 74 20 73 74 6d 74 6e 61 6d 65 bstruct stmtname
4730: 20 72 65 61 6c 70 61 72 61 6d 73 29 29 29 0a 20 realparams))).
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4750: 20 20 28 28 73 64 62 2d 71 72 79 29 20 20 20 20 ((sdb-qry)
4760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4770: 20 20 28 61 70 70 6c 79 20 73 64 62 3a 71 72 79 (apply sdb:qry
4780: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 ((p
47a0: 69 6e 67 29 20 20 20 20 20 20 20 20 20 20 20 20 ing)
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 75 (cu
47c0: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
47d0: 29 29 0a 09 09 20 20 20 28 28 67 65 74 2d 63 68 ))... ((get-ch
47e0: 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 anged-record-ids
47f0: 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 ) (apply d
4800: 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 b:get-changed-re
4810: 63 6f 72 64 2d 69 64 73 20 64 62 73 74 72 75 63 cord-ids dbstruc
4820: 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 t params))...
4830: 28 28 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 ((get-run-record
4840: 2d 69 64 73 29 20 09 20 20 20 28 61 70 70 6c 79 -ids) . (apply
4850: 20 64 62 3a 67 65 74 2d 72 75 6e 2d 72 65 63 6f db:get-run-reco
4860: 72 64 2d 69 64 73 20 64 62 73 74 72 75 63 74 20 rd-ids dbstruct
4870: 70 61 72 61 6d 73 29 29 09 0a 20 20 20 20 20 20 params))..
4880: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
4890: 54 45 53 54 4d 45 54 41 0a 20 20 20 20 20 20 20 TESTMETA.
48a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 ((te
48b0: 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 stmeta-get-recor
48c0: 64 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 d) (apply
48d0: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get-
48e0: 72 65 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 record dbstruct
48f0: 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 params))..
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
4910: 54 41 53 4b 53 20 0a 20 20 20 20 20 20 20 20 20 TASKS .
4920: 20 20 20 20 20 20 20 20 20 20 28 28 66 69 6e 64 ((find
4930: 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f -task-queue-reco
4940: 72 64 73 29 20 20 20 28 61 70 70 6c 79 20 74 61 rds) (apply ta
4950: 73 6b 73 3a 66 69 6e 64 2d 74 61 73 6b 2d 71 75 sks:find-task-qu
4960: 65 75 65 2d 72 65 63 6f 72 64 73 20 64 62 73 74 eue-records dbst
4970: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 ruct params))...
4980: 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 20 28 (else... (
4990: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
49a0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
49b0: 20 22 45 52 52 4f 52 3a 20 62 61 64 20 61 70 69 "ERROR: bad api
49c0: 20 63 61 6c 6c 20 22 20 63 6d 64 29 0a 09 09 20 call " cmd)...
49d0: 20 20 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a (conc "ERROR:
49e0: 20 42 41 44 20 61 70 69 20 63 61 6c 6c 20 22 20 BAD api call "
49f0: 63 6d 64 29 29 29 29 29 29 0a 0a 20 20 20 20 20 cmd))))))..
4a00: 20 20 0a 20 20 20 20 20 20 20 3b 3b 20 73 61 76 . ;; sav
4a10: 65 20 61 6c 6c 20 73 74 61 74 73 0a 20 20 20 20 e all stats.
4a20: 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 61 2d (let ((delta-
4a30: 74 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 t (- (current-mi
4a40: 6c 6c 69 73 65 63 6f 6e 64 73 29 0a 09 09 09 20 lliseconds)....
4a50: 73 74 61 72 74 2d 74 29 29 29 0a 09 20 28 68 61 start-t))).. (ha
4a60: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 64 sh-table-set! *d
4a70: 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d 65 2a b-api-call-time*
4a80: 20 63 6d 64 0a 09 09 09 20 20 28 63 6f 6e 73 20 cmd.... (cons
4a90: 64 65 6c 74 61 2d 74 20 28 68 61 73 68 2d 74 61 delta-t (hash-ta
4aa0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
4ab0: 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d *db-api-call-tim
4ac0: 65 2a 20 63 6d 64 20 27 28 29 29 29 29 29 0a 20 e* cmd '())))).
4ad0: 20 20 20 20 20 20 28 69 66 20 77 72 69 74 65 63 (if writec
4ae0: 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d md-in-readonly-m
4af0: 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 ode. (
4b00: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
4b10: 20 20 20 23 3b 28 63 6f 6d 6d 6f 6e 3a 74 65 6c #;(common:tel
4b20: 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 emetry-log (conc
4b30: 20 22 61 70 69 2d 6f 75 74 3a 22 28 2d 3e 73 74 "api-out:"(->st
4b40: 72 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 ring cmd)).
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
4b70: 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 6d 73 yload: `((params
4b80: 20 2e 20 2c 70 61 72 61 6d 73 29 0a 20 20 20 20 . ,params).
4b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bb0: 20 20 20 20 20 20 20 20 20 20 28 6f 6b 2d 72 65 (ok-re
4bc0: 73 20 2e 20 23 74 29 29 29 0a 09 20 20 20 20 20 s . #t)))..
4bd0: 28 76 65 63 74 6f 72 20 23 66 20 72 65 73 29 29 (vector #f res))
4be0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 . (beg
4bf0: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
4c00: 23 3b 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 #;(common:teleme
4c10: 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 61 try-log (conc "a
4c20: 70 69 2d 6f 75 74 3a 22 28 2d 3e 73 74 72 69 6e pi-out:"(->strin
4c30: 67 20 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 g cmd)).
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 20 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f paylo
4c60: 61 64 3a 20 60 28 28 70 61 72 61 6d 73 20 2e 20 ad: `((params .
4c70: 2c 70 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 ,params).
4c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ca0: 20 20 20 20 20 20 20 28 6f 6b 2d 72 65 73 20 2e (ok-res .
4cb0: 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f))).
4cc0: 20 20 20 20 28 76 65 63 74 6f 72 20 23 74 20 72 (vector #t r
4cd0: 65 73 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 68 es))))))))..;; h
4ce0: 74 74 70 2d 73 65 72 76 65 72 20 20 73 65 6e 64 ttp-server send
4cf0: 2d 72 65 73 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 -response.;;
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 70 69 api
4d10: 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 :process-request
4d20: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
4d30: 20 20 20 20 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b db:*.;;.;
4d40: 3b 20 4e 42 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 ; NB// Runs on t
4d50: 68 65 20 73 65 72 76 65 72 20 61 73 20 70 61 72 he server as par
4d60: 74 20 6f 66 20 74 68 65 20 73 65 72 76 65 72 20 t of the server
4d70: 6c 6f 6f 70 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 loop.;;.(define
4d80: 28 61 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 (api:process-req
4d90: 75 65 73 74 20 64 62 73 74 72 75 63 74 20 24 29 uest dbstruct $)
4da0: 20 3b 3b 20 74 68 65 20 24 20 69 73 20 74 68 65 ;; the $ is the
4db0: 20 72 65 71 75 65 73 74 20 76 61 72 73 20 70 72 request vars pr
4dc0: 6f 63 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e oc. (debug:prin
4dd0: 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 4 *default-log
4de0: 2d 70 6f 72 74 2a 20 22 73 65 72 76 65 72 2d 69 -port* "server-i
4df0: 64 3a 22 20 20 2a 73 65 72 76 65 72 2d 69 64 2a d:" *server-id*
4e00: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 20 ). (let* ((cmd
4e10: 20 20 20 20 28 24 20 27 63 6d 64 29 29 0a 09 20 ($ 'cmd))..
4e20: 28 70 61 72 61 6d 73 6a 20 28 24 20 27 70 61 72 (paramsj ($ 'par
4e30: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 ams)). (
4e40: 6b 65 79 20 20 20 20 20 28 24 20 27 6b 65 79 29 key ($ 'key)
4e50: 29 20 20 20 0a 09 20 28 70 61 72 61 6d 73 20 20 ) .. (params
4e60: 28 64 62 3a 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 (db:string->obj
4e70: 70 61 72 61 6d 73 6a 20 74 72 61 6e 73 70 6f 72 paramsj transpor
4e80: 74 3a 20 27 68 74 74 70 29 29 29 20 3b 3b 20 69 t: 'http))) ;; i
4e90: 6e 63 6f 6d 69 6e 67 20 64 61 74 61 20 66 72 6f ncoming data fro
4ea0: 6d 20 74 68 65 20 50 4f 53 54 20 28 6f 72 20 69 m the POST (or i
4eb0: 73 20 69 74 20 61 20 47 45 54 3f 29 0a 20 20 20 s it a GET?).
4ec0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
4ed0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4ee0: 74 2a 20 22 63 6d 64 3a 22 20 63 6d 64 20 22 20 t* "cmd:" cmd "
4ef0: 77 69 74 68 20 70 61 72 61 6d 73 20 22 20 70 61 with params " pa
4f00: 72 61 6d 73 20 22 6b 65 79 20 22 20 6b 65 79 29 rams "key " key)
4f10: 0a 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f . (if (equal?
4f20: 20 6b 65 79 20 2a 73 65 72 76 65 72 2d 69 64 2a key *server-id*
4f30: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 ). (begin.
4f40: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 61 70 (set! *ap
4f50: 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 i-process-reques
4f60: 74 2d 63 6f 75 6e 74 2a 20 28 2b 20 2a 61 70 69 t-count* (+ *api
4f70: 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 -process-request
4f80: 2d 63 6f 75 6e 74 2a 20 31 29 29 0a 20 09 28 6c -count* 1)). .(l
4f90: 65 74 2a 20 28 28 72 65 73 64 61 74 20 20 28 61 et* ((resdat (a
4fa0: 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 pi:execute-reque
4fb0: 73 74 73 20 64 62 73 74 72 75 63 74 20 28 76 65 sts dbstruct (ve
4fc0: 63 74 6f 72 20 63 6d 64 20 70 61 72 61 6d 73 29 ctor cmd params)
4fd0: 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 )) ;; process th
4fe0: 65 20 72 65 71 75 65 73 74 2c 20 72 65 73 64 61 e request, resda
4ff0: 74 20 3d 20 23 28 20 66 6c 61 67 20 72 65 73 75 t = #( flag resu
5000: 6c 74 20 29 0a 09 20 20 20 20 20 20 20 28 73 75 lt ).. (su
5010: 63 63 65 73 73 20 28 76 65 63 74 6f 72 2d 72 65 ccess (vector-re
5020: 66 20 72 65 73 64 61 74 20 30 29 29 0a 09 20 20 f resdat 0))..
5030: 20 20 20 20 20 28 72 65 73 20 20 20 20 20 28 76 (res (v
5040: 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 61 74 ector-ref resdat
5050: 20 31 29 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 1))) ;; (vector
5060: 20 66 6c 61 67 20 70 61 79 6c 6f 61 64 29 2c 20 flag payload),
5070: 67 65 74 20 74 68 65 20 70 61 79 6c 6f 61 64 2c get the payload,
5080: 20 69 67 6e 6f 72 65 20 74 68 65 20 66 6c 61 67 ignore the flag
5090: 20 28 77 68 79 3f 29 0a 09 20 20 28 64 65 62 75 (why?).. (debu
50a0: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
50b0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 lt-log-port* "re
50c0: 73 3a 22 20 72 65 73 29 0a 09 20 20 28 69 66 20 s:" res).. (if
50d0: 28 6e 6f 74 20 73 75 63 63 65 73 73 29 0a 09 20 (not success)..
50e0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
50f0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
5100: 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 73 -port* "ERROR: s
5110: 75 63 63 65 73 73 20 66 6c 61 67 20 69 73 20 23 uccess flag is #
5120: 66 20 66 6f 72 20 22 20 63 6d 64 20 22 20 77 69 f for " cmd " wi
5130: 74 68 20 70 61 72 61 6d 73 20 22 20 70 61 72 61 th params " para
5140: 6d 73 29 29 0a 09 20 20 28 69 66 20 28 3e 20 2a ms)).. (if (> *
5150: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
5160: 65 73 74 2d 63 6f 75 6e 74 2a 20 2a 6d 61 78 2d est-count* *max-
5170: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
5180: 65 73 74 73 2a 29 0a 09 20 20 20 20 20 20 28 73 ests*).. (s
5190: 65 74 21 20 2a 6d 61 78 2d 61 70 69 2d 70 72 6f et! *max-api-pro
51a0: 63 65 73 73 2d 72 65 71 75 65 73 74 73 2a 20 2a cess-requests* *
51b0: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
51c0: 65 73 74 2d 63 6f 75 6e 74 2a 29 29 0a 09 20 20 est-count*))..
51d0: 28 73 65 74 21 20 2a 61 70 69 2d 70 72 6f 63 65 (set! *api-proce
51e0: 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 ss-request-count
51f0: 2a 20 28 2d 20 2a 61 70 69 2d 70 72 6f 63 65 73 * (- *api-proces
5200: 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a s-request-count*
5210: 20 31 29 29 0a 09 20 20 3b 3b 20 54 68 69 73 20 1)).. ;; This
5220: 63 61 6e 20 62 65 20 68 65 72 65 20 62 75 74 20 can be here but
5230: 6e 65 65 64 73 20 63 6f 6e 74 72 6f 6c 73 20 74 needs controls t
5240: 6f 20 65 6e 73 75 72 65 20 69 74 20 64 6f 65 73 o ensure it does
5250: 6e 27 74 20 72 75 6e 20 6d 6f 72 65 20 74 68 61 n't run more tha
5260: 6e 20 65 76 65 72 79 20 34 20 73 65 63 6f 6e 64 n every 4 second
5270: 73 0a 09 20 20 3b 3b 20 28 72 6d 74 3a 64 61 74 s.. ;; (rmt:dat
5280: 2d 3e 6a 73 6f 6e 2d 73 74 72 0a 09 20 20 3b 3b ->json-str.. ;;
5290: 20 20 28 69 66 20 28 6f 72 20 28 73 74 72 69 6e (if (or (strin
52a0: 67 3f 20 72 65 73 29 0a 09 20 20 3b 3b 20 20 20 g? res).. ;;
52b0: 20 20 20 20 20 20 20 28 6c 69 73 74 3f 20 20 20 (list?
52c0: 72 65 73 29 0a 09 20 20 3b 3b 20 20 20 20 20 20 res).. ;;
52d0: 20 20 20 20 28 6e 75 6d 62 65 72 3f 20 72 65 73 (number? res
52e0: 29 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ).. ;;
52f0: 20 28 62 6f 6f 6c 65 61 6e 3f 20 72 65 73 29 29 (boolean? res))
5300: 0a 09 20 20 3b 3b 20 20 20 20 20 20 72 65 73 20 .. ;; res
5310: 0a 09 20 20 3b 3b 20 20 20 20 20 20 28 6c 69 73 .. ;; (lis
5320: 74 20 22 45 52 52 4f 52 2c 20 6e 6f 74 20 73 74 t "ERROR, not st
5330: 72 69 6e 67 2c 20 6c 69 73 74 2c 20 6e 75 6d 62 ring, list, numb
5340: 65 72 20 6f 72 20 62 6f 6f 6c 65 61 6e 22 20 31 er or boolean" 1
5350: 20 63 6d 64 20 70 61 72 61 6d 73 20 72 65 73 29 cmd params res)
5360: 29 29 29 29 0a 09 20 20 28 64 62 3a 6f 62 6a 2d )))).. (db:obj-
5370: 3e 73 74 72 69 6e 67 20 72 65 73 20 74 72 61 6e >string res tran
5380: 73 70 6f 72 74 3a 20 27 68 74 74 70 29 29 29 0a sport: 'http))).
5390: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
53a0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
53b0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 20 22 lt-log-port* "
53c0: 53 65 72 76 65 72 20 72 65 66 75 73 65 64 20 74 Server refused t
53d0: 6f 20 70 72 6f 63 65 73 73 20 72 65 71 75 65 73 o process reques
53e0: 74 2e 20 53 65 76 65 72 20 69 64 20 6d 69 73 6d t. Sever id mism
53f0: 61 74 63 68 2e 20 72 65 63 69 76 65 64 20 22 20 atch. recived "
5400: 6b 65 79 20 22 20 65 78 70 65 63 74 65 64 3a 20 key " expected:
5410: 20 22 20 2a 73 65 72 76 65 72 2d 69 64 2a 20 22 " *server-id* "
5420: 2e 5c 6e 4f 74 68 65 72 20 61 72 67 75 6d 65 6e .\nOther argumen
5430: 74 73 20 72 65 63 69 76 65 64 3a 20 63 6d 64 3d ts recived: cmd=
5440: 22 20 63 6d 64 20 22 20 70 61 72 61 6d 73 20 3d " cmd " params =
5450: 20 22 20 70 61 72 61 6d 73 29 20 0a 09 20 20 28 " params) .. (
5460: 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 28 db:obj->string (
5470: 63 6f 6e 63 20 22 53 65 72 76 65 72 20 72 65 66 conc "Server ref
5480: 75 73 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 used to process
5490: 72 65 71 75 65 73 74 20 73 65 72 76 65 72 2d 69 request server-i
54a0: 64 20 6d 69 73 6d 61 74 63 68 3a 20 22 20 6b 65 d mismatch: " ke
54b0: 79 20 22 2c 20 22 20 2a 73 65 72 76 65 72 2d 69 y ", " *server-i
54c0: 64 2a 29 20 74 72 61 6e 73 70 6f 72 74 3a 20 27 d*) transport: '
54d0: 68 74 74 70 29 29 29 29 29 0a 0a http)))))..