Artifact
2fe1f1cad54ffc02f631cf423d5a0747fae1edf1:
0000: 3b 3b 3d 3d 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 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 33 2c right 2006-2013,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 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 0a 0a 28 75 73 ===========..(us
0390: 65 20 73 72 66 69 2d 36 39 20 70 6f 73 69 78 29 e srfi-69 posix)
03a0: 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 ..(declare (unit
03b0: 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 api)).(declare
03c0: 28 75 73 65 73 20 72 6d 74 29 29 0a 28 64 65 63 (uses rmt)).(dec
03d0: 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a lare (uses db)).
03e0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 (declare (uses t
03f0: 61 73 6b 73 29 29 0a 0a 3b 3b 20 61 6c 6c 6f 77 asks))..;; allow
0400: 20 74 68 65 73 65 20 71 75 65 72 69 65 73 20 74 these queries t
0410: 68 72 6f 75 67 68 20 77 69 74 68 6f 75 74 20 73 hrough without s
0420: 74 61 72 74 69 6e 67 20 61 20 73 65 72 76 65 72 tarting a server
0430: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 61 70 69 3a .;;.(define api:
0440: 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 read-only-querie
0450: 73 0a 20 20 27 28 67 65 74 2d 6b 65 79 2d 76 61 s. '(get-key-va
0460: 6c 2d 70 61 69 72 73 0a 20 20 20 20 67 65 74 2d l-pairs. get-
0470: 76 61 72 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 var. get-keys
0480: 0a 20 20 20 20 67 65 74 2d 6b 65 79 2d 76 61 6c . get-key-val
0490: 73 0a 20 20 20 20 74 65 73 74 2d 74 6f 70 6c 65 s. test-tople
04a0: 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 0a 20 20 vel-num-items.
04b0: 20 20 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d get-test-info-
04c0: 62 79 2d 69 64 0a 20 20 20 20 67 65 74 2d 73 74 by-id. get-st
04d0: 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a 20 eps-info-by-id.
04e0: 20 20 20 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f get-data-info
04f0: 2d 62 79 2d 69 64 0a 20 20 20 20 74 65 73 74 2d -by-id. test-
0500: 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d get-rundir-from-
0510: 74 65 73 74 2d 69 64 0a 20 20 20 20 67 65 74 2d test-id. get-
0520: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
0530: 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 ing-for-testname
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 0a 20 20 20 ests-running.
0560: 20 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 get-count-tests
0570: 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 -running-in-jobg
0580: 72 6f 75 70 0a 20 20 20 20 67 65 74 2d 70 72 65 roup. get-pre
0590: 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 vious-test-run-r
05a0: 65 63 6f 72 64 0a 20 20 20 20 67 65 74 2d 6d 61 ecord. get-ma
05b0: 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d tching-previous-
05c0: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 test-run-records
05d0: 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d 6c 6f . test-get-lo
05e0: 67 66 69 6c 65 2d 69 6e 66 6f 0a 20 20 20 20 74 gfile-info. t
05f0: 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d est-get-records-
0600: 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 0a 20 for-index-file.
0610: 20 20 20 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d get-testinfo-
0620: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 state-status.
0630: 20 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 test-get-top-pr
0640: 6f 63 65 73 73 2d 70 69 64 0a 20 20 20 20 74 65 ocess-pid. te
0650: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
0660: 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 ching-keynames-t
0670: 61 72 67 65 74 2d 6e 65 77 0a 20 20 20 20 67 65 arget-new. ge
0680: 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 t-prereqs-not-me
0690: 74 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d t. get-count-
06a0: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f tests-running-fo
06b0: 72 2d 72 75 6e 2d 69 64 0a 20 20 20 20 67 65 74 r-run-id. get
06c0: 2d 72 75 6e 2d 69 6e 66 6f 0a 20 20 20 20 67 65 -run-info. ge
06d0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 0a 20 20 20 t-run-status.
06e0: 20 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 0a 20 get-run-state.
06f0: 20 20 20 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 get-run-stats
0700: 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 74 69 6d . get-run-tim
0710: 65 73 0a 20 20 20 20 67 65 74 2d 74 61 72 67 65 es. get-targe
0720: 74 73 0a 20 20 20 20 67 65 74 2d 74 61 72 67 65 ts. get-targe
0730: 74 0a 20 20 20 20 3b 3b 20 72 65 67 69 73 74 65 t. ;; registe
0740: 72 2d 72 75 6e 0a 20 20 20 20 67 65 74 2d 74 65 r-run. get-te
0750: 73 74 73 2d 74 61 67 73 0a 20 20 20 20 67 65 74 sts-tags. get
0760: 2d 74 65 73 74 2d 74 69 6d 65 73 0a 20 20 20 20 -test-times.
0770: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
0780: 6e 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d n. get-tests-
0790: 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 for-run-state-st
07a0: 61 74 75 73 0a 20 20 20 20 67 65 74 2d 74 65 73 atus. get-tes
07b0: 74 2d 69 64 0a 20 20 20 20 67 65 74 2d 74 65 73 t-id. get-tes
07c0: 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 ts-for-runs-mind
07d0: 61 74 61 0a 20 20 20 20 67 65 74 2d 74 65 73 74 ata. get-test
07e0: 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 s-for-run-mindat
07f0: 61 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 6e 61 a. get-run-na
0800: 6d 65 2d 66 72 6f 6d 2d 69 64 0a 20 20 20 20 67 me-from-id. g
0810: 65 74 2d 72 75 6e 73 0a 20 20 20 20 73 69 6d 70 et-runs. simp
0820: 6c 65 2d 67 65 74 2d 72 75 6e 73 0a 20 20 20 20 le-get-runs.
0830: 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 0a 20 20 20 get-num-runs.
0840: 20 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 get-runs-cnt-by
0850: 2d 70 61 74 74 0a 20 20 20 20 67 65 74 2d 61 6c -patt. get-al
0860: 6c 2d 72 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 l-run-ids. ge
0870: 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 0a 20 t-prev-run-ids.
0880: 20 20 20 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d get-run-ids-m
0890: 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 0a 20 atching-target.
08a0: 20 20 20 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 get-runs-by-p
08b0: 61 74 74 0a 20 20 20 20 67 65 74 2d 73 74 65 70 att. get-step
08c0: 73 2d 64 61 74 61 0a 20 20 20 20 67 65 74 2d 73 s-data. get-s
08d0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 teps-for-test.
08e0: 20 20 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 read-test-data
08f0: 0a 20 20 20 20 72 65 61 64 2d 74 65 73 74 2d 64 . read-test-d
0900: 61 74 61 2a 0a 20 20 20 20 6c 6f 67 69 6e 0a 20 ata*. login.
0910: 20 20 20 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 tasks-get-las
0920: 74 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d 67 t. testmeta-g
0930: 65 74 2d 72 65 63 6f 72 64 0a 20 20 20 20 68 61 et-record. ha
0940: 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 0a ve-incompletes?.
0950: 20 20 20 20 3b 3b 20 73 79 6e 63 68 61 73 68 2d ;; synchash-
0960: 67 65 74 0a 20 20 20 20 67 65 74 2d 63 68 61 6e get. get-chan
0970: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 0a 20 ged-record-ids.
0980: 20 20 20 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 get-run-recor
0990: 64 2d 69 64 73 20 0a 20 20 20 20 67 65 74 2d 6e d-ids . get-n
09a0: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
09b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 61 70 69 3a ))..(define api:
09c0: 77 72 69 74 65 2d 71 75 65 72 69 65 73 0a 20 20 write-queries.
09d0: 27 28 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 2d '(. get-keys-
09e0: 77 72 69 74 65 20 3b 3b 20 64 75 6d 6d 79 20 22 write ;; dummy "
09f0: 77 72 69 74 65 22 20 71 75 65 72 79 20 74 6f 20 write" query to
0a00: 66 6f 72 63 65 20 73 65 72 76 65 72 20 73 74 61 force server sta
0a10: 72 74 0a 0a 20 20 20 20 3b 3b 20 53 45 52 56 45 rt.. ;; SERVE
0a20: 52 53 0a 20 20 20 20 73 74 61 72 74 2d 73 65 72 RS. start-ser
0a30: 76 65 72 0a 20 20 20 20 6b 69 6c 6c 2d 73 65 72 ver. kill-ser
0a40: 76 65 72 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 ver.. ;; TEST
0a50: 53 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 73 S. test-set-s
0a60: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i
0a70: 64 0a 20 20 20 20 64 65 6c 65 74 65 2d 74 65 73 d. delete-tes
0a80: 74 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 64 65 t-records. de
0a90: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
0aa0: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 0a 20 20 -test-records.
0ab0: 20 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 test-set-state
0ac0: 2d 73 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 -status. test
0ad0: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
0ae0: 2d 70 69 64 0a 20 20 20 20 73 65 74 2d 73 74 61 -pid. set-sta
0af0: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
0b00: 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 ll-up-items.
0b10: 0a 20 20 20 20 75 70 64 61 74 65 2d 70 61 73 73 . update-pass
0b20: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 0a 20 20 20 -fail-counts.
0b30: 20 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 top-test-set-pe
0b40: 72 2d 70 66 2d 63 6f 75 6e 74 73 20 3b 3b 20 28 r-pf-counts ;; (
0b50: 64 62 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d db:top-test-set-
0b60: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 28 64 per-pf-counts (d
0b70: 62 3a 67 65 74 2d 64 62 20 2a 64 62 2a 20 35 29 b:get-db *db* 5)
0b80: 20 35 20 22 72 75 6e 66 69 72 73 74 22 29 0a 0a 5 "runfirst")..
0b90: 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 ;; RUNS.
0ba0: 72 65 67 69 73 74 65 72 2d 72 75 6e 0a 20 20 20 register-run.
0bb0: 20 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 set-tests-state
0bc0: 2d 73 74 61 74 75 73 0a 20 20 20 20 64 65 6c 65 -status. dele
0bd0: 74 65 2d 72 75 6e 0a 20 20 20 20 6c 6f 63 6b 2f te-run. lock/
0be0: 75 6e 6c 6f 63 6b 2d 72 75 6e 0a 20 20 20 20 75 unlock-run. u
0bf0: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
0c00: 74 69 6d 65 0a 20 20 20 20 6d 61 72 6b 2d 69 6e time. mark-in
0c10: 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 73 65 74 complete. set
0c20: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
0c30: 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 0a 20 20 d-roll-up-run.
0c40: 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 74 ;; STEPS. t
0c50: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
0c60: 75 73 21 0a 20 20 20 20 64 65 6c 65 74 65 2d 73 us!. delete-s
0c70: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 teps-for-test.
0c80: 20 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 ;; TEST DATA.
0c90: 20 20 20 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c test-data-rol
0ca0: 6c 75 70 0a 20 20 20 20 63 73 76 2d 3e 74 65 73 lup. csv->tes
0cb0: 74 2d 64 61 74 61 0a 0a 20 20 20 20 3b 3b 20 4d t-data.. ;; M
0cc0: 49 53 43 0a 20 20 20 20 73 79 6e 63 2d 69 6e 6d ISC. sync-inm
0cd0: 65 6d 2d 3e 64 62 0a 0a 20 20 20 20 3b 3b 20 54 em->db.. ;; T
0ce0: 45 53 54 4d 45 54 41 0a 20 20 20 20 74 65 73 74 ESTMETA. test
0cf0: 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 0a meta-add-record.
0d00: 20 20 20 20 74 65 73 74 6d 65 74 61 2d 75 70 64 testmeta-upd
0d10: 61 74 65 2d 66 69 65 6c 64 0a 0a 20 20 20 20 3b ate-field.. ;
0d20: 3b 20 54 41 53 4b 53 0a 20 20 20 20 74 61 73 6b ; TASKS. task
0d30: 73 2d 61 64 64 0a 20 20 20 20 74 61 73 6b 73 2d s-add. tasks-
0d40: 73 65 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d set-state-given-
0d50: 70 61 72 61 6d 2d 6b 65 79 0a 20 20 20 20 29 29 param-key. ))
0d60: 0a 0a 3b 3b 20 54 68 65 73 65 20 61 72 65 20 63 ..;; These are c
0d70: 61 6c 6c 65 64 20 62 79 20 74 68 65 20 73 65 72 alled by the ser
0d80: 76 65 72 20 6f 6e 20 72 65 63 69 70 74 20 6f 66 ver on recipt of
0d90: 20 2f 61 70 69 20 63 61 6c 6c 73 0a 3b 3b 20 20 /api calls.;;
0da0: 20 20 2d 20 6b 65 65 70 20 69 74 20 73 69 6d 70 - keep it simp
0db0: 6c 65 2c 20 6f 6e 6c 79 20 72 65 74 75 72 6e 20 le, only return
0dc0: 74 68 65 20 61 63 74 75 61 6c 20 72 65 73 75 6c the actual resul
0dd0: 74 20 6f 66 20 74 68 65 20 63 61 6c 6c 2c 20 69 t of the call, i
0de0: 2e 65 2e 20 6e 6f 20 6d 65 74 61 20 69 6e 66 6f .e. no meta info
0df0: 20 68 65 72 65 0a 3b 3b 0a 3b 3b 20 20 20 20 2d here.;;.;; -
0e00: 20 72 65 74 75 72 6e 73 20 23 28 20 66 6c 61 67 returns #( flag
0e10: 20 72 65 73 75 6c 74 20 29 0a 3b 3b 0a 28 64 65 result ).;;.(de
0e20: 66 69 6e 65 20 28 61 70 69 3a 65 78 65 63 75 74 fine (api:execut
0e30: 65 2d 72 65 71 75 65 73 74 73 20 64 62 73 74 72 e-requests dbstr
0e40: 75 63 74 20 64 61 74 29 0a 20 20 28 68 61 6e 64 uct dat). (hand
0e50: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
0e60: 20 65 78 6e 0a 20 20 20 28 6c 65 74 20 28 28 63 exn. (let ((c
0e70: 61 6c 6c 2d 63 68 61 69 6e 20 28 67 65 74 2d 63 all-chain (get-c
0e80: 61 6c 6c 2d 63 68 61 69 6e 29 29 29 0a 20 20 20 all-chain))).
0e90: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
0ea0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
0eb0: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 61 70 rt* "WARNING: ap
0ec0: 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 73 i:execute-reques
0ed0: 74 73 20 72 65 63 65 69 76 65 64 20 61 6e 20 65 ts received an e
0ee0: 78 63 65 70 74 69 6f 6e 20 66 72 6f 6d 20 70 65 xception from pe
0ef0: 65 72 2c 20 64 61 74 3d 22 20 64 61 74 29 0a 20 er, dat=" dat).
0f00: 20 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d (print-call-
0f10: 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 chain (current-e
0f20: 72 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 20 20 rror-port)).
0f30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
0f40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
0f50: 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 t* " message: "
0f60: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
0f70: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
0f80: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
0f90: 6e 29 29 20 20 20 20 20 20 20 0a 20 20 20 20 20 n)) .
0fa0: 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 74 (vector #f (vect
0fb0: 6f 72 20 65 78 6e 20 63 61 6c 6c 2d 63 68 61 69 or exn call-chai
0fc0: 6e 20 64 61 74 29 29 29 20 3b 3b 20 72 65 74 75 n dat))) ;; retu
0fd0: 72 6e 20 73 6f 6d 65 20 73 74 75 66 66 20 66 6f rn some stuff fo
0fe0: 72 20 64 65 62 75 67 20 69 66 20 61 6e 20 65 78 r debug if an ex
0ff0: 63 65 70 74 69 6f 6e 20 68 61 70 70 65 6e 73 0a ception happens.
1000: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 28 28 6e (cond. ((n
1010: 6f 74 20 28 76 65 63 74 6f 72 3f 20 64 61 74 29 ot (vector? dat)
1020: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
1030: 20 20 20 20 20 3b 3b 20 69 74 20 69 73 20 61 6e ;; it is an
1040: 20 65 72 72 6f 72 20 74 6f 20 6e 6f 74 20 72 65 error to not re
1050: 63 65 69 76 65 20 61 20 76 65 63 74 6f 72 0a 20 ceive a vector.
1060: 20 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 28 (vector #f (
1070: 76 65 63 74 6f 72 20 23 66 20 22 72 65 6d 6f 74 vector #f "remot
1080: 65 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 e must be called
1090: 20 77 69 74 68 20 61 20 76 65 63 74 6f 72 22 29 with a vector")
10a0: 29 29 0a 20 20 20 20 28 28 3e 20 2a 61 70 69 2d )). ((> *api-
10b0: 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d process-request-
10c0: 63 6f 75 6e 74 2a 20 32 30 29 20 3b 3b 20 32 30 count* 20) ;; 20
10d0: 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 ). (debug:pr
10e0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
10f0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
1100: 47 3a 20 61 70 69 3a 65 78 65 63 75 74 65 2d 72 G: api:execute-r
1110: 65 71 75 65 73 74 73 20 72 65 63 65 69 76 65 64 equests received
1120: 20 61 6e 20 6f 76 65 72 6c 6f 61 64 65 64 20 6d an overloaded m
1130: 65 73 73 61 67 65 2e 22 29 0a 20 20 20 20 20 28 essage."). (
1140: 73 65 74 21 20 2a 73 65 72 76 65 72 2d 6f 76 65 set! *server-ove
1150: 72 6c 6f 61 64 65 64 2a 20 23 74 29 0a 20 20 20 rloaded* #t).
1160: 20 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 (vector #f (ve
1170: 63 74 6f 72 20 23 66 20 27 6f 76 65 72 6c 6f 61 ctor #f 'overloa
1180: 64 65 64 29 29 29 20 3b 3b 20 74 68 65 20 69 6e ded))) ;; the in
1190: 6e 65 72 20 76 65 63 74 6f 72 20 69 73 20 77 68 ner vector is wh
11a0: 61 74 20 67 65 74 73 20 72 65 74 75 72 6e 65 64 at gets returned
11b0: 2e 20 6e 6f 70 65 2c 20 64 6f 6e 27 74 20 6b 6e . nope, don't kn
11c0: 6f 77 20 77 68 79 2e 20 70 6c 65 61 73 65 20 72 ow why. please r
11d0: 65 66 61 63 74 6f 72 21 0a 20 20 20 20 28 65 6c efactor!. (el
11e0: 73 65 20 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 se . (let*
11f0: 28 28 63 6d 64 2d 69 6e 20 20 20 20 20 20 20 20 ((cmd-in
1200: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
1210: 64 61 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 dat 0)).
1220: 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 (cmd
1230: 20 20 20 20 20 20 20 28 69 66 20 28 73 79 6d 62 (if (symb
1240: 6f 6c 3f 20 63 6d 64 2d 69 6e 29 0a 09 09 09 09 ol? cmd-in).....
1250: 20 20 20 63 6d 64 2d 69 6e 0a 09 09 09 09 20 20 cmd-in.....
1260: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
1270: 20 63 6d 64 2d 69 6e 29 29 29 0a 20 20 20 20 20 cmd-in))).
1280: 20 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 20 (params
1290: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
12a0: 72 2d 72 65 66 20 64 61 74 20 31 29 29 0a 20 20 r-ref dat 1)).
12b0: 20 20 20 20 20 20 20 20 20 20 28 73 74 61 72 74 (start
12c0: 2d 74 20 20 20 20 20 20 20 20 20 20 20 28 63 75 -t (cu
12d0: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
12e0: 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ds)).
12f0: 20 28 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 (readonly-mode
1300: 20 20 20 20 28 64 62 72 3a 64 62 73 74 72 75 63 (dbr:dbstruc
1310: 74 2d 72 65 61 64 2d 6f 6e 6c 79 20 64 62 73 74 t-read-only dbst
1320: 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 ruct)).
1330: 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d 63 6f 6d (readonly-com
1340: 6d 61 6e 64 20 20 28 6d 65 6d 62 65 72 20 63 6d mand (member cm
1350: 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d d api:read-only-
1360: 71 75 65 72 69 65 73 29 29 0a 20 20 20 20 20 20 queries)).
1370: 20 20 20 20 20 20 28 77 72 69 74 65 63 6d 64 2d (writecmd-
1380: 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 in-readonly-mode
1390: 20 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 2d 6d (and readonly-m
13a0: 6f 64 65 20 28 6e 6f 74 20 72 65 61 64 6f 6e 6c ode (not readonl
13b0: 79 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 20 20 20 y-command))).
13c0: 20 20 20 20 20 20 20 20 20 28 66 6f 6f 20 20 20 (foo
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
13e0: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1400: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 (common:tele
1410: 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 metry-log (conc
1420: 22 61 70 69 2d 69 6e 3a 22 28 2d 3e 73 74 72 69 "api-in:"(->stri
1430: 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 20 20 ng cmd)).
1440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1470: 70 61 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 payload: `((para
1480: 6d 73 20 2e 20 2c 70 61 72 61 6d 73 29 29 29 0a ms . ,params))).
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14d0: 20 20 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 #t)).
14e0: 20 20 20 20 28 72 65 73 20 20 20 20 0a 20 20 20 (res .
14f0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 77 72 (if wr
1500: 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e itecmd-in-readon
1510: 6c 79 2d 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 ly-mode.
1520: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 (conc "
1530: 61 74 74 65 6d 70 74 20 74 6f 20 72 75 6e 20 77 attempt to run w
1540: 72 69 74 65 20 63 6f 6d 6d 61 6e 64 20 22 63 6d rite command "cm
1550: 64 22 20 6f 6e 20 61 20 72 65 61 64 2d 6f 6e 6c d" on a read-onl
1560: 79 20 64 61 74 61 62 61 73 65 22 29 0a 20 20 20 y database").
1570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
1580: 61 73 65 20 63 6d 64 0a 20 20 20 20 20 20 20 20 ase cmd.
1590: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d ;;===
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 ============.
15d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e0: 3b 3b 20 52 45 41 44 2f 57 52 49 54 45 20 51 55 ;; READ/WRITE QU
15f0: 45 52 49 45 53 0a 20 20 20 20 20 20 20 20 20 20 ERIES.
1600: 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d ;;=====
1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 20 20 20 ==========..
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1650: 28 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 29 (get-keys-write)
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1670: 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d (db:get-
1680: 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 20 keys dbstruct))
1690: 3b 3b 20 66 6f 72 63 65 20 61 20 64 75 6d 6d 79 ;; force a dummy
16a0: 20 22 77 72 69 74 65 22 20 71 75 65 72 79 20 74 "write" query t
16b0: 6f 20 66 6f 72 63 65 20 73 65 72 76 65 72 3b 20 o force server;
16c0: 66 6f 72 20 64 65 62 75 67 20 69 6e 20 2d 72 65 for debug in -re
16d0: 70 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 pl.
16e0: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
16f0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 53 45 52 ;; SER
1700: 56 45 52 53 0a 20 20 20 20 20 20 20 20 20 20 20 VERS.
1710: 20 20 20 20 20 20 20 20 28 28 73 74 61 72 74 2d ((start-
1720: 73 65 72 76 65 72 29 20 20 20 20 20 20 20 20 20 server)
1730: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
1740: 79 20 73 65 72 76 65 72 3a 6b 69 6e 64 2d 72 75 y server:kind-ru
1750: 6e 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 n params)).
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1770: 6b 69 6c 6c 2d 73 65 72 76 65 72 29 20 20 20 20 kill-server)
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1790: 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 2d 72 (set! *server-r
17a0: 75 6e 2a 20 23 66 29 29 0a 0a 20 20 20 20 20 20 un* #f))..
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
17c0: 54 45 53 54 53 0a 0a 20 20 20 20 20 20 20 20 20 TESTS..
17d0: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 74 65 ;;((te
17e0: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
17f0: 74 75 73 2d 62 79 2d 69 64 29 20 20 20 20 20 28 tus-by-id) (
1800: 61 70 70 6c 79 20 6d 74 3a 74 65 73 74 2d 73 65 apply mt:test-se
1810: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
1820: 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 y-id dbstruct pa
1830: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
1840: 20 20 20 20 20 20 20 20 20 20 3b 3b 42 42 20 2d ;;BB -
1850: 20 63 6f 6d 6d 65 6e 74 65 64 20 6f 75 74 20 61 commented out a
1860: 62 6f 76 65 20 62 65 63 61 75 73 65 20 69 74 20 bove because it
1870: 77 61 73 20 63 61 6c 6c 69 6e 67 20 62 65 6c 6f was calling belo
1880: 77 2c 20 65 76 65 6e 74 75 61 6c 6c 79 2c 20 69 w, eventually, i
1890: 6e 63 6f 72 72 65 63 74 6c 79 20 28 64 62 73 74 ncorrectly (dbst
18a0: 72 75 63 74 20 70 61 73 73 65 64 20 74 6f 20 6d ruct passed to m
18b0: 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 t:test-set-state
18c0: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 2c 20 77 -status-by-id, w
18d0: 68 69 63 68 20 70 72 65 76 69 6f 73 6c 79 20 64 hich previosly d
18e0: 69 64 20 6d 6f 72 65 2c 20 62 75 74 20 6e 6f 77 id more, but now
18f0: 20 6f 6e 6c 79 20 70 61 73 73 65 73 20 74 68 72 only passes thr
1900: 75 20 74 6f 20 64 62 3a 73 65 74 2d 73 74 61 74 u to db:set-stat
1910: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
1920: 6c 2d 75 70 2d 69 74 65 6d 73 2e 0a 20 20 20 20 l-up-items..
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1940: 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d (test-set-state-
1950: 73 74 61 74 75 73 2d 62 79 2d 69 64 29 0a 0a 20 status-by-id)..
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1970: 20 20 20 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 ;; (define (d
1980: 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 b:set-state-stat
1990: 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 us-and-roll-up-i
19a0: 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 72 75 tems dbstruct ru
19b0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
19c0: 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 20 73 tem-path state s
19d0: 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 0a 20 tatus comment).
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 20 28 64 62 3a 73 65 74 2d 73 74 61 74 65 (db:set-state
1a00: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
1a10: 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 20 20 -up-items.
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 d
1a30: 62 73 74 72 75 63 74 0a 20 20 20 20 20 20 20 20 bstruct.
1a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
1a50: 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 30 29 st-ref params 0)
1a60: 20 3b 20 72 75 6e 2d 69 64 0a 20 20 20 20 20 20 ; run-id.
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1a80: 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 list-ref params
1a90: 31 29 20 3b 20 74 65 73 74 2d 6e 61 6d 65 0a 20 1) ; test-name.
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ab0: 20 20 20 20 23 66 20 20 20 20 20 20 20 20 20 20 #f
1ac0: 20 20 20 20 20 20 20 20 3b 20 69 74 65 6d 2d 70 ; item-p
1ad0: 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 ath.
1ae0: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 (list-r
1af0: 65 66 20 70 61 72 61 6d 73 20 32 29 20 3b 20 73 ef params 2) ; s
1b00: 74 61 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 tate.
1b10: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d (list-
1b20: 72 65 66 20 70 61 72 61 6d 73 20 33 29 20 3b 20 ref params 3) ;
1b30: 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 20 status.
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
1b50: 74 2d 72 65 66 20 70 61 72 61 6d 73 20 34 29 20 t-ref params 4)
1b60: 3b 20 63 6f 6d 6d 65 6e 74 0a 20 20 20 20 20 20 ; comment.
1b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
1b80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1b90: 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 .
1ba0: 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74 ((delet
1bb0: 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 20 e-test-records)
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
1bd0: 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 ly db:delete-tes
1be0: 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 t-records dbstru
1bf0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1c10: 28 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 (delete-old-dele
1c20: 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ted-test-records
1c30: 29 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 ) (apply db:dele
1c40: 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 te-old-deleted-t
1c50: 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 est-records dbst
1c60: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
1c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c80: 20 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ((test-set-stat
1c90: 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20 e-status)
1ca0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 (apply db:te
1cb0: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
1cc0: 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 tus dbstruct par
1cd0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
1ce0: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d ((test-
1cf0: 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d set-top-process-
1d00: 70 69 64 29 20 20 20 20 20 20 20 20 28 61 70 70 pid) (app
1d10: 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 ly db:test-set-t
1d20: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 64 op-process-pid d
1d30: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
1d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d50: 20 20 20 20 28 28 73 65 74 2d 73 74 61 74 65 2d ((set-state-
1d60: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d status-and-roll-
1d70: 75 70 2d 69 74 65 6d 73 29 20 28 61 70 70 6c 79 up-items) (apply
1d80: 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 db:set-state-st
1d90: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1da0: 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 -items dbstruct
1db0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 ((se
1dd0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 t-state-status-a
1de0: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 29 20 nd-roll-up-run)
1df0: 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 73 74 (apply db:set-st
1e00: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
1e10: 6f 6c 6c 2d 75 70 2d 72 75 6e 20 64 62 73 74 72 oll-up-run dbstr
1e20: 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a 20 20 uct params)) .
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 28 28 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d ((top-test-set-
1e50: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 29 20 20 per-pf-counts)
1e60: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 6f (apply db:to
1e70: 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 p-test-set-per-p
1e80: 66 2d 63 6f 75 6e 74 73 20 64 62 73 74 72 75 63 f-counts dbstruc
1e90: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
1ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1eb0: 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 test-set-archive
1ec0: 2d 62 6c 6f 63 6b 2d 69 64 29 20 20 20 20 20 20 -block-id)
1ed0: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
1ee0: 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 set-archive-bloc
1ef0: 6b 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 k-id dbstruct pa
1f00: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
1f10: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 55 ;; RU
1f20: 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 NS.
1f30: 20 20 20 20 20 20 28 28 72 65 67 69 73 74 65 72 ((register
1f40: 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 -run)
1f50: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1f60: 72 65 67 69 73 74 65 72 2d 72 75 6e 20 64 62 73 register-run dbs
1f70: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 20 28 28 73 65 74 2d 74 65 73 74 73 2d 73 74 ((set-tests-st
1fa0: 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 ate-status)
1fb0: 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d (apply db:set-
1fc0: 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 tests-state-stat
1fd0: 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 us dbstruct para
1fe0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
1ff0: 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74 65 ((delete
2000: 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 -run)
2010: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2020: 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 73 b:delete-run dbs
2030: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2050: 20 20 28 28 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d ((lock/unlock-
2060: 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 run)
2070: 20 20 28 61 70 70 6c 79 20 64 62 3a 6c 6f 63 6b (apply db:lock
2080: 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 64 62 73 74 /unlock-run dbst
2090: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 20 28 28 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 ((update-run-ev
20c0: 65 6e 74 5f 74 69 6d 65 29 20 20 20 20 20 20 20 ent_time)
20d0: 20 28 61 70 70 6c 79 20 64 62 3a 75 70 64 61 74 (apply db:updat
20e0: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
20f0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2100: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2110: 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d 72 ((update-r
2120: 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 un-stats)
2130: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2140: 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 update-run-stats
2150: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2160: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2170: 20 20 20 20 20 20 28 28 73 65 74 2d 76 61 72 29 ((set-var)
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
21a0: 73 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 set-var dbstruct
21b0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 ((d
21d0: 65 6c 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 el-var)
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
21f0: 70 6c 79 20 64 62 3a 64 65 6c 2d 76 61 72 20 64 ply db:del-var d
2200: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2210: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2220: 20 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 ;; STEPS.
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2240: 20 28 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d ((teststep-set-
2250: 73 74 61 74 75 73 21 29 20 20 20 20 20 20 20 20 status!)
2260: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 73 (apply db:tests
2270: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
2280: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2290: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
22a0: 20 20 20 20 20 28 28 64 65 6c 65 74 65 2d 73 74 ((delete-st
22b0: 65 70 73 2d 66 6f 72 2d 74 65 73 74 21 29 20 20 eps-for-test!)
22c0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
22d0: 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 delete-steps-for
22e0: 2d 74 65 73 74 21 20 64 62 73 74 72 75 63 74 20 -test! dbstruct
22f0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2300: 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 .
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2320: 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 ;; TEST DATA.
2330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2340: 28 28 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c ((test-data-roll
2350: 75 70 29 20 20 20 20 20 20 20 20 20 20 20 20 20 up)
2360: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 64 (apply db:test-d
2370: 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 73 74 72 ata-rollup dbstr
2380: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 28 28 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 ((csv->test-data
23b0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
23c0: 28 61 70 70 6c 79 20 64 62 3a 63 73 76 2d 3e 74 (apply db:csv->t
23d0: 65 73 74 2d 64 61 74 61 20 64 62 73 74 72 75 63 est-data dbstruc
23e0: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2400: 3b 20 4d 49 53 43 0a 20 20 20 20 20 20 20 20 20 ; MISC.
2410: 20 20 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 ((sync
2420: 2d 69 6e 6d 65 6d 2d 3e 64 62 29 20 20 20 20 20 -inmem->db)
2430: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
2440: 28 72 75 6e 2d 69 64 20 28 63 61 72 20 70 61 72 (run-id (car par
2450: 61 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ams))).
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2480: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
2490: 73 79 6e 63 2d 74 6f 75 63 68 65 64 20 64 62 73 sync-touched dbs
24a0: 74 72 75 63 74 20 72 75 6e 2d 69 64 20 66 6f 72 truct run-id for
24b0: 63 65 2d 73 79 6e 63 3a 20 23 74 29 29 29 0a 20 ce-sync: #t))).
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24d0: 20 20 28 28 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c ((mark-incompl
24e0: 65 74 65 29 20 20 20 20 20 20 20 20 20 20 20 20 ete)
24f0: 20 20 28 61 70 70 6c 79 20 64 62 3a 66 69 6e 64 (apply db:find
2500: 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
2510: 6c 65 74 65 20 64 62 73 74 72 75 63 74 20 70 61 lete dbstruct pa
2520: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
2530: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
2540: 53 54 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 STMETA.
2550: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
2560: 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 29 meta-add-record)
2570: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2580: 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 :testmeta-add-re
2590: 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 70 61 cord dbstruct pa
25a0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
25b0: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
25c0: 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c meta-update-fiel
25d0: 64 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 d) (apply db
25e0: 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 :testmeta-update
25f0: 2d 66 69 65 6c 64 20 64 62 73 74 72 75 63 74 20 -field dbstruct
2600: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2610: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
2620: 74 2d 74 65 73 74 73 2d 74 61 67 73 29 20 20 20 t-tests-tags)
2630: 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 (db:get
2640: 2d 74 65 73 74 73 2d 74 61 67 73 20 64 62 73 74 -tests-tags dbst
2650: 72 75 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 ruct))..
2660: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 ;; TA
2670: 53 4b 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 SKS.
2680: 20 20 20 20 20 20 20 28 28 74 61 73 6b 73 2d 61 ((tasks-a
2690: 64 64 29 20 20 20 20 20 20 20 20 20 20 20 20 20 dd)
26a0: 20 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 (apply tasks
26b0: 3a 61 64 64 20 64 62 73 74 72 75 63 74 20 70 61 :add dbstruct pa
26c0: 72 61 6d 73 29 29 20 20 20 0a 20 20 20 20 20 20 rams)) .
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
26e0: 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 asks-set-state-g
26f0: 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 29 20 iven-param-key)
2700: 28 61 70 70 6c 79 20 74 61 73 6b 73 3a 73 65 74 (apply tasks:set
2710: 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 -state-given-par
2720: 61 6d 2d 6b 65 79 20 64 62 73 74 72 75 63 74 20 am-key dbstruct
2730: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2740: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 ((ta
2750: 73 6b 73 2d 67 65 74 2d 6c 61 73 74 29 20 20 20 sks-get-last)
2760: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2770: 74 61 73 6b 73 3a 67 65 74 2d 6c 61 73 74 20 64 tasks:get-last d
2780: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2790: 0a 0a 09 09 20 20 20 3b 3b 20 4e 4f 20 53 59 4e .... ;; NO SYN
27a0: 43 20 44 42 0a 09 09 20 20 20 28 28 6e 6f 2d 73 C DB... ((no-s
27b0: 79 6e 63 2d 73 65 74 29 20 20 20 20 20 20 20 20 ync-set)
27c0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
27d0: 3a 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 20 20 20 :no-sync-set
27e0: 20 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 *no-sync-db
27f0: 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 * params))...
2800: 28 28 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 ((no-sync-get/de
2810: 66 61 75 6c 74 29 20 20 20 20 20 20 20 28 61 70 fault) (ap
2820: 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 67 ply db:no-sync-g
2830: 65 74 2f 64 65 66 61 75 6c 74 20 2a 6e 6f 2d 73 et/default *no-s
2840: 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 ync-db* params))
2850: 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d ... ((no-sync-
2860: 64 65 6c 21 29 20 20 20 20 20 20 20 20 20 20 20 del!)
2870: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d (apply db:no-
2880: 73 79 6e 63 2d 64 65 6c 21 20 20 20 20 20 20 20 sync-del!
2890: 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 *no-sync-db* pa
28a0: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f rams))... ((no
28b0: 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 29 20 -sync-get-lock)
28c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
28d0: 64 62 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c db:no-sync-get-l
28e0: 6f 63 6b 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d ock *no-sync-
28f0: 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 db* params))...
2900: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2910: 20 20 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 ;; ARCHIVE
2920: 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 S.
2930: 20 20 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 ;; ((archiv
2940: 65 2d 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e e-get-allocation
2950: 73 29 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 s) .
2960: 20 20 20 20 20 20 20 20 20 28 28 61 72 63 68 69 ((archi
2970: 76 65 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b ve-register-disk
2980: 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a ) (apply db:
2990: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
29a0: 2d 64 69 73 6b 20 64 62 73 74 72 75 63 74 20 70 -disk dbstruct p
29b0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
29c0: 20 20 20 20 20 20 20 20 20 20 20 28 28 61 72 63 ((arc
29d0: 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c hive-register-bl
29e0: 6f 63 6b 2d 6e 61 6d 65 29 28 61 70 70 6c 79 20 ock-name)(apply
29f0: 64 62 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 db:archive-regis
2a00: 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 64 ter-block-name d
2a10: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2a30: 20 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 ;; ((archive
2a40: 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 -allocate-testsu
2a50: 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 ite/area-to-bloc
2a60: 6b 29 28 61 70 70 6c 79 20 64 62 3a 61 72 63 68 k)(apply db:arch
2a70: 69 76 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 ive-allocate-tes
2a80: 74 73 75 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 tsuite/area-to-b
2a90: 6c 6f 63 6b 20 64 62 73 74 72 75 63 74 20 62 6c lock dbstruct bl
2aa0: 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 ock-id testsuite
2ab0: 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 29 0a -name areakey)).
2ac0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2ad0: 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==========
2ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 ============.
2b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b30: 3b 3b 20 52 45 41 44 20 4f 4e 4c 59 20 51 55 45 ;; READ ONLY QUE
2b40: 52 49 45 53 0a 20 20 20 20 20 20 20 20 20 20 20 RIES.
2b50: 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d ;;======
2b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ba0: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2bb0: 20 20 20 20 20 3b 3b 20 4b 45 59 53 0a 20 20 20 ;; KEYS.
2bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bd0: 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 ((get-key-val-pa
2be0: 69 72 73 29 20 20 20 20 20 20 20 20 20 20 20 20 irs)
2bf0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
2c00: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 -key-val-pairs d
2c10: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2c20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2c30: 20 20 20 20 28 28 67 65 74 2d 6b 65 79 73 29 20 ((get-keys)
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c50: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b (db:get-k
2c60: 65 79 73 20 64 62 73 74 72 75 63 74 29 29 0a 20 eys dbstruct)).
2c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c80: 20 20 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 ((get-key-vals
2c90: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2ca0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
2cb0: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 73 74 et-key-vals dbst
2cc0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
2cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ce0: 20 28 28 67 65 74 2d 74 61 72 67 65 74 29 20 20 ((get-target)
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d00: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
2d10: 74 2d 74 61 72 67 65 74 20 64 62 73 74 72 75 63 t-target dbstruc
2d20: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2d40: 67 65 74 2d 74 61 72 67 65 74 73 29 20 20 20 20 get-targets)
2d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d60: 20 28 64 62 3a 67 65 74 2d 74 61 72 67 65 74 73 (db:get-targets
2d70: 20 64 62 73 74 72 75 63 74 29 29 0a 0a 20 20 20 dbstruct))..
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d90: 3b 3b 20 41 52 43 48 49 56 45 53 0a 20 20 20 20 ;; ARCHIVES.
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2db0: 28 74 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 (test-get-archiv
2dc0: 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 29 20 20 20 e-block-info)
2dd0: 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 (apply db:test
2de0: 2d 67 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f -get-archive-blo
2df0: 63 6b 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 ck-info dbstruct
2e00: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
2e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 .
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e30: 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 20 20 20 ;; TESTS.
2e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
2e50: 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d est-toplevel-num
2e60: 2d 69 74 65 6d 73 29 20 20 20 20 20 20 20 20 20 -items)
2e70: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 74 (apply db:test-t
2e80: 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d oplevel-num-item
2e90: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
2ea0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2eb0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 ((get-tes
2ec0: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 09 20 20 t-info-by-id).
2ed0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
2ee0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
2ef0: 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 id dbstruct para
2f00: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2f10: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 ((test-g
2f20: 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 et-rundir-from-t
2f30: 65 73 74 2d 69 64 29 20 20 20 20 28 61 70 70 6c est-id) (appl
2f40: 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 y db:test-get-ru
2f50: 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 ndir-from-test-i
2f60: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
2f70: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2f80: 20 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 ((get-cou
2f90: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
2fa0: 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 29 20 28 -for-testname) (
2fb0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 apply db:get-cou
2fc0: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
2fd0: 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 20 64 62 -for-testname db
2fe0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3000: 20 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 ((get-count-t
3010: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 29 20 20 20 ests-running)
3020: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3030: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
3040: 72 75 6e 6e 69 6e 67 20 64 62 73 74 72 75 63 74 running dbstruct
3050: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3060: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
3070: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
3080: 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f unning-in-jobgro
3090: 75 70 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 up) (apply db:ge
30a0: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
30b0: 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 nning-in-jobgrou
30c0: 70 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d p dbstruct param
30d0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
30e0: 20 20 20 20 20 20 20 3b 3b 20 28 28 64 65 6c 65 ;; ((dele
30f0: 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 te-test-step-rec
3100: 6f 72 64 73 29 20 20 20 20 20 20 20 20 28 61 70 ords) (ap
3110: 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 ply db:delete-te
3120: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 st-step-records
3130: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3140: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3150: 20 20 20 20 20 3b 3b 20 28 28 67 65 74 2d 70 72 ;; ((get-pr
3160: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
3170: 72 65 63 6f 72 64 29 20 20 20 20 28 61 70 70 6c record) (appl
3180: 79 20 64 62 3a 67 65 74 2d 70 72 65 76 69 6f 75 y db:get-previou
3190: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
31a0: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
31b0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
31c0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 6d 61 74 ((get-mat
31d0: 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 ching-previous-t
31e0: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 29 est-run-records)
31f0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6d 61 (apply db:get-ma
3200: 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d tching-previous-
3210: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 test-run-records
3220: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3230: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3240: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 ((test-get
3250: 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 29 20 20 -logfile-info)
3260: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3270: 64 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 db:test-get-logf
3280: 69 6c 65 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 ile-info dbstruc
3290: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
32a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
32b0: 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 test-get-records
32c0: 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 29 -for-index-file)
32d0: 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 (apply db:test
32e0: 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 -get-records-for
32f0: 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 62 73 74 -index-file dbst
3300: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3320: 20 28 28 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d ((get-testinfo-
3330: 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 state-status)
3340: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
3350: 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 t-testinfo-state
3360: 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 74 -status dbstruct
3370: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3380: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
3390: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
33a0: 65 73 73 2d 70 69 64 29 20 20 20 20 20 20 20 20 ess-pid)
33b0: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 (apply db:test-g
33c0: 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 et-top-process-p
33d0: 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 id dbstruct para
33e0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
33f0: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 ((test-g
3400: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
3410: 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 g-keynames-targe
3420: 74 2d 6e 65 77 29 20 28 61 70 70 6c 79 20 64 62 t-new) (apply db
3430: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
3440: 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 matching-keyname
3450: 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 64 62 73 s-target-new dbs
3460: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3480: 20 20 28 28 67 65 74 2d 70 72 65 72 65 71 73 2d ((get-prereqs-
3490: 6e 6f 74 2d 6d 65 74 29 20 20 20 20 20 20 20 20 not-met)
34a0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
34b0: 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d et-prereqs-not-m
34c0: 65 74 20 64 62 73 74 72 75 63 74 20 70 61 72 61 et dbstruct para
34d0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
34e0: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f ((get-co
34f0: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
3500: 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 29 20 28 61 g-for-run-id) (a
3510: 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e pply db:get-coun
3520: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
3530: 66 6f 72 2d 72 75 6e 2d 69 64 20 64 62 73 74 72 for-run-id dbstr
3540: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3560: 28 28 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 ((get-not-comple
3570: 74 65 64 2d 63 6e 74 29 20 20 20 20 20 20 20 20 ted-cnt)
3580: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3590: 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 -not-completed-c
35a0: 6e 74 20 20 64 62 73 74 72 75 63 74 20 70 61 72 nt dbstruct par
35b0: 61 6d 73 29 29 20 0a 20 20 20 20 20 20 20 20 20 ams)) .
35c0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 73 ;; ((s
35d0: 79 6e 63 68 61 73 68 2d 67 65 74 29 20 20 20 20 ynchash-get)
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35f0: 28 61 70 70 6c 79 20 73 79 6e 63 68 61 73 68 3a (apply synchash:
3600: 73 65 72 76 65 72 2d 67 65 74 20 64 62 73 74 72 server-get dbstr
3610: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3630: 28 28 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 ((get-raw-run-st
3640: 61 74 73 29 20 20 20 20 20 20 20 20 20 20 20 20 ats)
3650: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3660: 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 64 -raw-run-stats d
3670: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3680: 0a 09 09 20 20 20 28 28 67 65 74 2d 74 65 73 74 ... ((get-test
3690: 2d 74 69 6d 65 73 29 20 20 20 20 20 20 20 20 20 -times)
36a0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
36b0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 db:get-test-time
36c0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
36d0: 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 s))..
36e0: 20 20 20 20 20 20 20 20 3b 3b 20 52 55 4e 53 0a ;; RUNS.
36f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3700: 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 69 6e 66 ((get-run-inf
3710: 6f 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 o)
3720: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3730: 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 73 74 72 75 -run-info dbstru
3740: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3760: 28 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 (get-run-status)
3770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3780: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3790: 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 74 -status dbstruct
37a0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
37b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
37c0: 65 74 2d 72 75 6e 2d 73 74 61 74 65 29 20 20 20 et-run-state)
37d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
37e0: 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 ply db:get-run-s
37f0: 74 61 74 65 20 64 62 73 74 72 75 63 74 20 70 61 tate dbstruct pa
3800: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3810: 20 20 20 20 20 20 20 20 20 20 28 28 73 65 74 2d ((set-
3820: 72 75 6e 2d 73 74 61 74 75 73 29 20 20 20 20 20 run-status)
3830: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
3840: 20 64 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 db:set-run-stat
3850: 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 us dbstruct para
3860: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
3870: 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 72 75 ((set-ru
3880: 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 n-state-status)
3890: 20 09 09 09 20 28 61 70 70 6c 79 20 64 62 3a 73 ... (apply db:s
38a0: 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 et-run-state-sta
38b0: 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 tus dbstruct par
38c0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
38d0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 ((get-t
38e0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 29 20 20 20 ests-for-run)
38f0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3900: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
3910: 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 70 61 -run dbstruct pa
3920: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3930: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3940: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 tests-for-run-st
3950: 61 74 65 2d 73 74 61 74 75 73 29 20 28 61 70 70 ate-status) (app
3960: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d ly db:get-tests-
3970: 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 for-run-state-st
3980: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 atus dbstruct pa
3990: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
39a0: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
39b0: 74 65 73 74 2d 69 64 29 20 20 20 20 20 20 20 20 test-id)
39c0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
39d0: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 db:get-test-id
39e0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
39f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3a00: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 73 ((get-tests
3a10: 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 -for-run-mindata
3a20: 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 ) (apply db:g
3a30: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
3a40: 2d 6d 69 6e 64 61 74 61 20 64 62 73 74 72 75 63 -mindata dbstruc
3a50: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
3a70: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 ((get-tests-for
3a80: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 29 20 20 -runs-mindata)
3a90: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3aa0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 ests-for-runs-mi
3ab0: 6e 64 61 74 61 20 64 62 73 74 72 75 63 74 20 70 ndata dbstruct p
3ac0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3ad0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3ae0: 2d 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 -runs)
3af0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
3b00: 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 y db:get-runs db
3b10: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b30: 20 20 20 28 28 73 69 6d 70 6c 65 2d 67 65 74 2d ((simple-get-
3b40: 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 20 runs)
3b50: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 69 6d (apply db:sim
3b60: 70 6c 65 2d 67 65 74 2d 72 75 6e 73 20 64 62 73 ple-get-runs dbs
3b70: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b90: 20 20 28 28 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 ((get-num-runs
3ba0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3bb0: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3bc0: 6e 75 6d 2d 72 75 6e 73 20 64 62 73 74 72 75 63 num-runs dbstruc
3bd0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3bf0: 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d get-runs-cnt-by-
3c00: 70 61 74 74 29 20 20 20 20 20 20 20 20 20 28 61 patt) (a
3c10: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 pply db:get-runs
3c20: 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 64 62 73 -cnt-by-patt dbs
3c30: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c50: 20 20 28 28 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d ((get-all-run-
3c60: 69 64 73 29 20 20 20 20 20 20 20 20 20 20 20 20 ids)
3c70: 20 20 28 64 62 3a 67 65 74 2d 61 6c 6c 2d 72 75 (db:get-all-ru
3c80: 6e 2d 69 64 73 20 64 62 73 74 72 75 63 74 29 29 n-ids dbstruct))
3c90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3ca0: 20 20 20 20 28 28 67 65 74 2d 70 72 65 76 2d 72 ((get-prev-r
3cb0: 75 6e 2d 69 64 73 29 20 20 20 20 20 20 20 20 20 un-ids)
3cc0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
3cd0: 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 64 t-prev-run-ids d
3ce0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3cf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3d00: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 69 64 ((get-run-id
3d10: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 s-matching-targe
3d20: 74 29 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 t) (apply db:ge
3d30: 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 t-run-ids-matchi
3d40: 6e 67 2d 74 61 72 67 65 74 20 64 62 73 74 72 75 ng-target dbstru
3d50: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d70: 28 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 (get-runs-by-pat
3d80: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 t) (
3d90: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3da0: 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 s-by-patt dbstru
3db0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3dd0: 28 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 (get-run-name-fr
3de0: 6f 6d 2d 69 64 29 20 20 20 20 20 20 20 20 20 28 om-id) (
3df0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3e00: 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 64 62 -name-from-id db
3e10: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e30: 20 20 20 28 28 67 65 74 2d 6d 61 69 6e 2d 72 75 ((get-main-ru
3e40: 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 20 n-stats)
3e50: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3e60: 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 -main-run-stats
3e70: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3e80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3e90: 20 20 20 20 20 28 28 67 65 74 2d 76 61 72 29 20 ((get-var)
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3eb0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
3ec0: 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 et-var dbstruct
3ed0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3ee0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
3ef0: 74 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20 t-run-stats)
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
3f10: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 ly db:get-run-st
3f20: 61 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72 ats dbstruct par
3f30: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
3f40: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
3f50: 75 6e 2d 74 69 6d 65 73 29 20 20 20 20 20 20 20 un-times)
3f60: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3f70: 64 62 3a 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 db:get-run-times
3f80: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3f90: 29 29 20 0a 0a 20 20 20 20 20 20 20 20 20 20 20 )) ..
3fa0: 20 20 20 20 20 20 20 20 3b 3b 20 53 54 45 50 53 ;; STEPS
3fb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3fc0: 20 20 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d ((get-steps-
3fd0: 64 61 74 61 29 20 20 20 20 20 20 20 20 20 20 20 data)
3fe0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
3ff0: 74 2d 73 74 65 70 73 2d 64 61 74 61 20 64 62 73 t-steps-data dbs
4000: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4020: 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d 66 6f ((get-steps-fo
4030: 72 2d 74 65 73 74 29 20 20 20 20 20 20 20 20 20 r-test)
4040: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
4050: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 steps-for-test d
4060: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
4070: 0a 09 09 20 20 20 28 28 67 65 74 2d 73 74 65 70 ... ((get-step
4080: 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 20 s-info-by-id)
4090: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
40a0: 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62 get-steps-info-b
40b0: 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 y-id dbstruct pa
40c0: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
40d0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
40e0: 53 54 20 44 41 54 41 0a 20 20 20 20 20 20 20 20 ST DATA.
40f0: 20 20 20 20 20 20 20 20 20 20 20 28 28 72 65 61 ((rea
4100: 64 2d 74 65 73 74 2d 64 61 74 61 29 20 20 20 20 d-test-data)
4110: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
4120: 79 20 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 y db:read-test-d
4130: 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 ata dbstruct par
4140: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
4150: 20 20 20 20 20 20 20 20 20 28 28 72 65 61 64 2d ((read-
4160: 74 65 73 74 2d 64 61 74 61 2a 29 20 20 20 20 20 test-data*)
4170: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
4180: 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 db:read-test-dat
4190: 61 2a 20 64 62 73 74 72 75 63 74 20 70 61 72 61 a* dbstruct para
41a0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
41b0: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 64 61 ((get-da
41c0: 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 ta-info-by-id)
41d0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
41e0: 62 3a 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d b:get-data-info-
41f0: 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 by-id dbstruct p
4200: 61 72 61 6d 73 29 29 20 0a 0a 20 20 20 20 20 20 arams)) ..
4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
4220: 4d 49 53 43 0a 20 20 20 20 20 20 20 20 20 20 20 MISC.
4230: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6c 61 ((get-la
4240: 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 29 20 test-host-load)
4250: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
4260: 62 3a 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f 73 b:get-latest-hos
4270: 74 2d 6c 6f 61 64 20 64 62 73 74 72 75 63 74 20 t-load dbstruct
4280: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
4290: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 68 61 ((ha
42a0: 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 29 ve-incompletes?)
42b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
42c0: 6c 79 20 64 62 3a 68 61 76 65 2d 69 6e 63 6f 6d ly db:have-incom
42d0: 70 6c 65 74 65 73 3f 20 64 62 73 74 72 75 63 74 pletes? dbstruct
42e0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c ((l
4300: 6f 67 69 6e 29 20 20 20 20 20 20 20 20 20 20 20 ogin)
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
4320: 70 6c 79 20 64 62 3a 6c 6f 67 69 6e 20 64 62 73 ply db:login dbs
4330: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 28 28 67 65 6e 65 72 61 6c 2d 63 61 6c 6c ((general-call
4360: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4370: 20 20 28 6c 65 74 20 28 28 73 74 6d 74 6e 61 6d (let ((stmtnam
4380: 65 20 20 20 28 63 61 72 20 70 61 72 61 6d 73 29 e (car params)
4390: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43c0: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d (run-
43d0: 69 64 20 20 20 20 20 28 63 61 64 72 20 70 61 72 id (cadr par
43e0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4420: 72 65 61 6c 70 61 72 61 6d 73 20 28 63 64 64 72 realparams (cddr
4430: 20 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 params))).
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c (db:general-call
4480: 20 64 62 73 74 72 75 63 74 20 73 74 6d 74 6e 61 dbstruct stmtna
4490: 6d 65 20 72 65 61 6c 70 61 72 61 6d 73 29 29 29 me realparams)))
44a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
44b0: 20 20 20 20 28 28 73 64 62 2d 71 72 79 29 20 20 ((sdb-qry)
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44d0: 20 20 20 20 28 61 70 70 6c 79 20 73 64 62 3a 71 (apply sdb:q
44e0: 72 79 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ry params)).
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4500: 28 70 69 6e 67 29 20 20 20 20 20 20 20 20 20 20 (ping)
4510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4520: 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d current-process-
4530: 69 64 29 29 0a 09 09 20 20 20 28 28 67 65 74 2d id))... ((get-
4540: 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d 69 changed-record-i
4550: 64 73 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 ds) (apply
4560: 20 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d db:get-changed-
4570: 72 65 63 6f 72 64 2d 69 64 73 20 64 62 73 74 72 record-ids dbstr
4580: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 uct params))...
4590: 20 20 28 28 67 65 74 2d 72 75 6e 2d 72 65 63 6f ((get-run-reco
45a0: 72 64 2d 69 64 73 29 20 09 20 20 20 28 61 70 70 rd-ids) . (app
45b0: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 72 65 ly db:get-run-re
45c0: 63 6f 72 64 2d 69 64 73 20 64 62 73 74 72 75 63 cord-ids dbstruc
45d0: 74 20 70 61 72 61 6d 73 29 29 09 0a 20 20 20 20 t params))..
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
45f0: 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 20 ; TESTMETA.
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
4610: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 testmeta-get-rec
4620: 6f 72 64 29 20 20 20 20 20 20 20 28 61 70 70 6c ord) (appl
4630: 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 y db:testmeta-ge
4640: 74 2d 72 65 63 6f 72 64 20 64 62 73 74 72 75 63 t-record dbstruc
4650: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
4660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
4670: 3b 20 54 41 53 4b 53 20 0a 20 20 20 20 20 20 20 ; TASKS .
4680: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 66 69 ((fi
4690: 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 nd-task-queue-re
46a0: 63 6f 72 64 73 29 20 20 20 28 61 70 70 6c 79 20 cords) (apply
46b0: 74 61 73 6b 73 3a 66 69 6e 64 2d 74 61 73 6b 2d tasks:find-task-
46c0: 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 64 62 queue-records db
46d0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
46e0: 09 09 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 .. (else...
46f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4700: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4710: 74 2a 20 22 45 52 52 4f 52 3a 20 62 61 64 20 61 t* "ERROR: bad a
4720: 70 69 20 63 61 6c 6c 20 22 20 63 6d 64 29 0a 09 pi call " cmd)..
4730: 09 20 20 20 20 28 63 6f 6e 63 20 22 45 52 52 4f . (conc "ERRO
4740: 52 3a 20 42 41 44 20 61 70 69 20 63 61 6c 6c 20 R: BAD api call
4750: 22 20 63 6d 64 29 29 29 29 29 29 0a 0a 20 20 20 " cmd))))))..
4760: 20 20 20 20 0a 20 20 20 20 20 20 20 3b 3b 20 73 . ;; s
4770: 61 76 65 20 61 6c 6c 20 73 74 61 74 73 0a 20 20 ave all stats.
4780: 20 20 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 (let ((delt
4790: 61 2d 74 20 28 2d 20 28 63 75 72 72 65 6e 74 2d a-t (- (current-
47a0: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 0a 09 09 milliseconds)...
47b0: 09 20 73 74 61 72 74 2d 74 29 29 29 0a 09 20 28 . start-t))).. (
47c0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
47d0: 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d *db-api-call-tim
47e0: 65 2a 20 63 6d 64 0a 09 09 09 20 20 28 63 6f 6e e* cmd.... (con
47f0: 73 20 64 65 6c 74 61 2d 74 20 28 68 61 73 68 2d s delta-t (hash-
4800: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4810: 74 20 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 t *db-api-call-t
4820: 69 6d 65 2a 20 63 6d 64 20 27 28 29 29 29 29 29 ime* cmd '()))))
4830: 0a 20 20 20 20 20 20 20 28 69 66 20 77 72 69 74 . (if writ
4840: 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 ecmd-in-readonly
4850: 2d 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 -mode.
4860: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
4870: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c (common:tel
4880: 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 emetry-log (conc
4890: 20 22 61 70 69 2d 6f 75 74 3a 22 28 2d 3e 73 74 "api-out:"(->st
48a0: 72 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 ring cmd)).
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
48d0: 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 6d 73 yload: `((params
48e0: 20 2e 20 2c 70 61 72 61 6d 73 29 0a 20 20 20 20 . ,params).
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4910: 20 20 20 20 20 20 20 20 20 20 28 6f 6b 2d 72 65 (ok-re
4920: 73 20 2e 20 23 74 29 29 29 0a 09 20 20 20 20 20 s . #t)))..
4930: 28 76 65 63 74 6f 72 20 23 66 20 72 65 73 29 29 (vector #f res))
4940: 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 . (beg
4950: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
4960: 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 (common:telemetr
4970: 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 69 y-log (conc "api
4980: 2d 6f 75 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 -out:"(->string
4990: 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 cmd)).
49a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49b0: 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f 61 64 payload
49c0: 3a 20 60 28 28 70 61 72 61 6d 73 20 2e 20 2c 70 : `((params . ,p
49d0: 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20 arams).
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a00: 20 20 20 20 20 28 6f 6b 2d 72 65 73 20 2e 20 23 (ok-res . #
4a10: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
4a20: 20 20 28 76 65 63 74 6f 72 20 23 74 20 72 65 73 (vector #t res
4a30: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 68 74 74 ))))))))..;; htt
4a40: 70 2d 73 65 72 76 65 72 20 20 73 65 6e 64 2d 72 p-server send-r
4a50: 65 73 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 20 20 esponse.;;
4a60: 20 20 20 20 20 20 20 20 20 20 20 61 70 69 3a 70 api:p
4a70: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 0a 3b rocess-request.;
4a80: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
4a90: 20 20 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b 3b 20 db:*.;;.;;
4aa0: 4e 42 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 68 65 NB// Runs on the
4ab0: 20 73 65 72 76 65 72 20 61 73 20 70 61 72 74 20 server as part
4ac0: 6f 66 20 74 68 65 20 73 65 72 76 65 72 20 6c 6f of the server lo
4ad0: 6f 70 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 op.;;.(define (a
4ae0: 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi:process-reque
4af0: 73 74 20 64 62 73 74 72 75 63 74 20 24 29 20 3b st dbstruct $) ;
4b00: 3b 20 74 68 65 20 24 20 69 73 20 74 68 65 20 72 ; the $ is the r
4b10: 65 71 75 65 73 74 20 76 61 72 73 20 70 72 6f 63 equest vars proc
4b20: 0a 20 20 28 73 65 74 21 20 2a 61 70 69 2d 70 72 . (set! *api-pr
4b30: 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f ocess-request-co
4b40: 75 6e 74 2a 20 28 2b 20 2a 61 70 69 2d 70 72 6f unt* (+ *api-pro
4b50: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
4b60: 6e 74 2a 20 31 29 29 0a 20 20 28 6c 65 74 2a 20 nt* 1)). (let*
4b70: 28 28 63 6d 64 20 20 20 20 20 28 24 20 27 63 6d ((cmd ($ 'cm
4b80: 64 29 29 0a 09 20 28 70 61 72 61 6d 73 6a 20 28 d)).. (paramsj (
4b90: 24 20 27 70 61 72 61 6d 73 29 29 0a 09 20 28 70 $ 'params)).. (p
4ba0: 61 72 61 6d 73 20 20 28 64 62 3a 73 74 72 69 6e arams (db:strin
4bb0: 67 2d 3e 6f 62 6a 20 70 61 72 61 6d 73 6a 20 74 g->obj paramsj t
4bc0: 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 ransport: 'http)
4bd0: 29 20 3b 3b 20 69 6e 63 6f 6d 69 6e 67 20 64 61 ) ;; incoming da
4be0: 74 61 20 66 72 6f 6d 20 74 68 65 20 50 4f 53 54 ta from the POST
4bf0: 20 28 6f 72 20 69 73 20 69 74 20 61 20 47 45 54 (or is it a GET
4c00: 3f 29 0a 09 20 28 72 65 73 64 61 74 20 20 28 61 ?).. (resdat (a
4c10: 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 pi:execute-reque
4c20: 73 74 73 20 64 62 73 74 72 75 63 74 20 28 76 65 sts dbstruct (ve
4c30: 63 74 6f 72 20 63 6d 64 20 70 61 72 61 6d 73 29 ctor cmd params)
4c40: 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 )) ;; process th
4c50: 65 20 72 65 71 75 65 73 74 2c 20 72 65 73 64 61 e request, resda
4c60: 74 20 3d 20 23 28 20 66 6c 61 67 20 72 65 73 75 t = #( flag resu
4c70: 6c 74 20 29 0a 09 20 28 73 75 63 63 65 73 73 20 lt ).. (success
4c80: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 (vector-ref resd
4c90: 61 74 20 30 29 29 0a 09 20 28 72 65 73 20 20 20 at 0)).. (res
4ca0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 (vector-ref re
4cb0: 73 64 61 74 20 31 29 29 29 20 3b 3b 20 28 76 65 sdat 1))) ;; (ve
4cc0: 63 74 6f 72 20 66 6c 61 67 20 70 61 79 6c 6f 61 ctor flag payloa
4cd0: 64 29 2c 20 67 65 74 20 74 68 65 20 70 61 79 6c d), get the payl
4ce0: 6f 61 64 2c 20 69 67 6e 6f 72 65 20 74 68 65 20 oad, ignore the
4cf0: 66 6c 61 67 20 28 77 68 79 3f 29 0a 20 20 20 20 flag (why?).
4d00: 28 69 66 20 28 6e 6f 74 20 73 75 63 63 65 73 73 (if (not success
4d10: 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 )..(debug:print
4d20: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4d30: 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 73 75 63 ort* "ERROR: suc
4d40: 63 65 73 73 20 66 6c 61 67 20 69 73 20 23 66 20 cess flag is #f
4d50: 66 6f 72 20 22 20 63 6d 64 20 22 20 77 69 74 68 for " cmd " with
4d60: 20 70 61 72 61 6d 73 20 22 20 70 61 72 61 6d 73 params " params
4d70: 29 29 0a 20 20 20 20 28 69 66 20 28 3e 20 2a 61 )). (if (> *a
4d80: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi-process-reque
4d90: 73 74 2d 63 6f 75 6e 74 2a 20 2a 6d 61 78 2d 61 st-count* *max-a
4da0: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi-process-reque
4db0: 73 74 73 2a 29 0a 09 28 73 65 74 21 20 2a 6d 61 sts*)..(set! *ma
4dc0: 78 2d 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 x-api-process-re
4dd0: 71 75 65 73 74 73 2a 20 2a 61 70 69 2d 70 72 6f quests* *api-pro
4de0: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
4df0: 6e 74 2a 29 29 0a 20 20 20 20 28 73 65 74 21 20 nt*)). (set!
4e00: 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 *api-process-req
4e10: 75 65 73 74 2d 63 6f 75 6e 74 2a 20 28 2d 20 2a uest-count* (- *
4e20: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
4e30: 65 73 74 2d 63 6f 75 6e 74 2a 20 31 29 29 0a 20 est-count* 1)).
4e40: 20 20 20 3b 3b 20 54 68 69 73 20 63 61 6e 20 62 ;; This can b
4e50: 65 20 68 65 72 65 20 62 75 74 20 6e 65 65 64 73 e here but needs
4e60: 20 63 6f 6e 74 72 6f 6c 73 20 74 6f 20 65 6e 73 controls to ens
4e70: 75 72 65 20 69 74 20 64 6f 65 73 6e 27 74 20 72 ure it doesn't r
4e80: 75 6e 20 6d 6f 72 65 20 74 68 61 6e 20 65 76 65 un more than eve
4e90: 72 79 20 34 20 73 65 63 6f 6e 64 73 0a 20 20 20 ry 4 seconds.
4ea0: 20 3b 3b 20 28 72 6d 74 3a 64 61 74 2d 3e 6a 73 ;; (rmt:dat->js
4eb0: 6f 6e 2d 73 74 72 0a 20 20 20 20 3b 3b 20 20 28 on-str. ;; (
4ec0: 69 66 20 28 6f 72 20 28 73 74 72 69 6e 67 3f 20 if (or (string?
4ed0: 72 65 73 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 res). ;;
4ee0: 20 20 20 20 20 28 6c 69 73 74 3f 20 20 20 72 65 (list? re
4ef0: 73 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 s). ;;
4f00: 20 20 20 28 6e 75 6d 62 65 72 3f 20 72 65 73 29 (number? res)
4f10: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 . ;;
4f20: 20 28 62 6f 6f 6c 65 61 6e 3f 20 72 65 73 29 29 (boolean? res))
4f30: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 72 65 73 . ;; res
4f40: 20 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 28 6c . ;; (l
4f50: 69 73 74 20 22 45 52 52 4f 52 2c 20 6e 6f 74 20 ist "ERROR, not
4f60: 73 74 72 69 6e 67 2c 20 6c 69 73 74 2c 20 6e 75 string, list, nu
4f70: 6d 62 65 72 20 6f 72 20 62 6f 6f 6c 65 61 6e 22 mber or boolean"
4f80: 20 31 20 63 6d 64 20 70 61 72 61 6d 73 20 72 65 1 cmd params re
4f90: 73 29 29 29 29 29 0a 20 20 20 20 28 64 62 3a 6f s))))). (db:o
4fa0: 62 6a 2d 3e 73 74 72 69 6e 67 20 72 65 73 20 74 bj->string res t
4fb0: 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 ransport: 'http)
4fc0: 29 29 0a 0a ))..