Artifact
cb8c71faca4fbc597de07466d9d9d28ffc8d0df2:
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 2d 69 n. get-test-i
0790: 64 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d d. get-tests-
07a0: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
07b0: 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d 66 . get-tests-f
07c0: 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 0a 20 or-run-mindata.
07d0: 20 20 20 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d get-run-name-
07e0: 66 72 6f 6d 2d 69 64 0a 20 20 20 20 67 65 74 2d from-id. get-
07f0: 72 75 6e 73 0a 20 20 20 20 73 69 6d 70 6c 65 2d runs. simple-
0800: 67 65 74 2d 72 75 6e 73 0a 20 20 20 20 67 65 74 get-runs. get
0810: 2d 6e 75 6d 2d 72 75 6e 73 0a 20 20 20 20 67 65 -num-runs. ge
0820: 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 t-runs-cnt-by-pa
0830: 74 74 0a 20 20 20 20 67 65 74 2d 61 6c 6c 2d 72 tt. get-all-r
0840: 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 74 2d 70 un-ids. get-p
0850: 72 65 76 2d 72 75 6e 2d 69 64 73 0a 20 20 20 20 rev-run-ids.
0860: 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 get-run-ids-matc
0870: 68 69 6e 67 2d 74 61 72 67 65 74 0a 20 20 20 20 hing-target.
0880: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
0890: 0a 20 20 20 20 67 65 74 2d 73 74 65 70 73 2d 64 . get-steps-d
08a0: 61 74 61 0a 20 20 20 20 67 65 74 2d 73 74 65 70 ata. get-step
08b0: 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 20 20 72 s-for-test. r
08c0: 65 61 64 2d 74 65 73 74 2d 64 61 74 61 0a 20 20 ead-test-data.
08d0: 20 20 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 read-test-data
08e0: 2a 0a 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 *. login.
08f0: 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 0a 20 tasks-get-last.
0900: 20 20 20 74 65 73 74 6d 65 74 61 2d 67 65 74 2d testmeta-get-
0910: 72 65 63 6f 72 64 0a 20 20 20 20 68 61 76 65 2d record. have-
0920: 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 0a 20 20 20 incompletes?.
0930: 20 3b 3b 20 73 79 6e 63 68 61 73 68 2d 67 65 74 ;; synchash-get
0940: 0a 20 20 20 20 67 65 74 2d 63 68 61 6e 67 65 64 . get-changed
0950: 2d 72 65 63 6f 72 64 2d 69 64 73 0a 09 09 67 65 -record-ids...ge
0960: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 t-run-record-ids
0970: 20 0a 20 20 20 20 67 65 74 2d 6e 6f 74 2d 63 6f . get-not-co
0980: 6d 70 6c 65 74 65 64 2d 63 6e 74 29 29 0a 0a 28 mpleted-cnt))..(
0990: 64 65 66 69 6e 65 20 61 70 69 3a 77 72 69 74 65 define api:write
09a0: 2d 71 75 65 72 69 65 73 0a 20 20 27 28 0a 20 20 -queries. '(.
09b0: 20 20 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 get-keys-write
09c0: 20 3b 3b 20 64 75 6d 6d 79 20 22 77 72 69 74 65 ;; dummy "write
09d0: 22 20 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 " query to force
09e0: 20 73 65 72 76 65 72 20 73 74 61 72 74 0a 0a 20 server start..
09f0: 20 20 20 3b 3b 20 53 45 52 56 45 52 53 0a 20 20 ;; SERVERS.
0a00: 20 20 73 74 61 72 74 2d 73 65 72 76 65 72 0a 20 start-server.
0a10: 20 20 20 6b 69 6c 6c 2d 73 65 72 76 65 72 0a 0a kill-server..
0a20: 20 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 ;; TESTS.
0a30: 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d test-set-state-
0a40: 73 74 61 74 75 73 2d 62 79 2d 69 64 0a 20 20 20 status-by-id.
0a50: 20 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 delete-test-rec
0a60: 6f 72 64 73 0a 20 20 20 20 64 65 6c 65 74 65 2d ords. delete-
0a70: 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 old-deleted-test
0a80: 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 74 65 73 -records. tes
0a90: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
0aa0: 75 73 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d us. test-set-
0ab0: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 0a top-process-pid.
0ac0: 20 20 20 20 73 65 74 2d 73 74 61 74 65 2d 73 74 set-state-st
0ad0: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
0ae0: 2d 69 74 65 6d 73 0a 20 20 20 20 20 0a 20 20 20 -items. .
0af0: 20 75 70 64 61 74 65 2d 70 61 73 73 2d 66 61 69 update-pass-fai
0b00: 6c 2d 63 6f 75 6e 74 73 0a 20 20 20 20 74 6f 70 l-counts. top
0b10: 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 -test-set-per-pf
0b20: 2d 63 6f 75 6e 74 73 20 3b 3b 20 28 64 62 3a 74 -counts ;; (db:t
0b30: 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d op-test-set-per-
0b40: 70 66 2d 63 6f 75 6e 74 73 20 28 64 62 3a 67 65 pf-counts (db:ge
0b50: 74 2d 64 62 20 2a 64 62 2a 20 35 29 20 35 20 22 t-db *db* 5) 5 "
0b60: 72 75 6e 66 69 72 73 74 22 29 0a 0a 20 20 20 20 runfirst")..
0b70: 3b 3b 20 52 55 4e 53 0a 20 20 20 20 72 65 67 69 ;; RUNS. regi
0b80: 73 74 65 72 2d 72 75 6e 0a 20 20 20 20 73 65 74 ster-run. set
0b90: 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 -tests-state-sta
0ba0: 74 75 73 0a 20 20 20 20 64 65 6c 65 74 65 2d 72 tus. delete-r
0bb0: 75 6e 0a 20 20 20 20 6c 6f 63 6b 2f 75 6e 6c 6f un. lock/unlo
0bc0: 63 6b 2d 72 75 6e 0a 20 20 20 20 75 70 64 61 74 ck-run. updat
0bd0: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
0be0: 0a 20 20 20 20 6d 61 72 6b 2d 69 6e 63 6f 6d 70 . mark-incomp
0bf0: 6c 65 74 65 0a 20 20 20 20 73 65 74 2d 73 74 61 lete. set-sta
0c00: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
0c10: 6c 6c 2d 75 70 2d 72 75 6e 0a 20 20 20 20 3b 3b ll-up-run. ;;
0c20: 20 53 54 45 50 53 0a 20 20 20 20 74 65 73 74 73 STEPS. tests
0c30: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 0a tep-set-status!.
0c40: 20 20 20 20 64 65 6c 65 74 65 2d 73 74 65 70 73 delete-steps
0c50: 2d 66 6f 72 2d 74 65 73 74 0a 20 20 20 20 3b 3b -for-test. ;;
0c60: 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 20 74 TEST DATA. t
0c70: 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 0a est-data-rollup.
0c80: 20 20 20 20 63 73 76 2d 3e 74 65 73 74 2d 64 61 csv->test-da
0c90: 74 61 0a 0a 20 20 20 20 3b 3b 20 4d 49 53 43 0a ta.. ;; MISC.
0ca0: 20 20 20 20 73 79 6e 63 2d 69 6e 6d 65 6d 2d 3e sync-inmem->
0cb0: 64 62 0a 20 20 20 20 64 72 6f 70 2d 61 6c 6c 2d db. drop-all-
0cc0: 74 72 69 67 67 65 72 73 0a 20 20 20 20 63 72 65 triggers. cre
0cd0: 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 ate-all-triggers
0ce0: 0a 20 20 20 20 75 70 64 61 74 65 2d 74 65 73 64 . update-tesd
0cf0: 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 ata-on-repilcate
0d00: 2d 64 62 20 0a 20 20 20 20 3b 3b 20 54 45 53 54 -db . ;; TEST
0d10: 4d 45 54 41 0a 20 20 20 20 74 65 73 74 6d 65 74 META. testmet
0d20: 61 2d 61 64 64 2d 72 65 63 6f 72 64 0a 20 20 20 a-add-record.
0d30: 20 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 testmeta-update
0d40: 2d 66 69 65 6c 64 0a 0a 20 20 20 20 3b 3b 20 54 -field.. ;; T
0d50: 41 53 4b 53 0a 20 20 20 20 74 61 73 6b 73 2d 61 ASKS. tasks-a
0d60: 64 64 0a 20 20 20 20 74 61 73 6b 73 2d 73 65 74 dd. tasks-set
0d70: 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 -state-given-par
0d80: 61 6d 2d 6b 65 79 0a 20 20 20 20 29 29 0a 0a 3b am-key. ))..;
0d90: 3b 20 54 68 65 73 65 20 61 72 65 20 63 61 6c 6c ; These are call
0da0: 65 64 20 62 79 20 74 68 65 20 73 65 72 76 65 72 ed by the server
0db0: 20 6f 6e 20 72 65 63 69 70 74 20 6f 66 20 2f 61 on recipt of /a
0dc0: 70 69 20 63 61 6c 6c 73 0a 3b 3b 20 20 20 20 2d pi calls.;; -
0dd0: 20 6b 65 65 70 20 69 74 20 73 69 6d 70 6c 65 2c keep it simple,
0de0: 20 6f 6e 6c 79 20 72 65 74 75 72 6e 20 74 68 65 only return the
0df0: 20 61 63 74 75 61 6c 20 72 65 73 75 6c 74 20 6f actual result o
0e00: 66 20 74 68 65 20 63 61 6c 6c 2c 20 69 2e 65 2e f the call, i.e.
0e10: 20 6e 6f 20 6d 65 74 61 20 69 6e 66 6f 20 68 65 no meta info he
0e20: 72 65 0a 3b 3b 0a 3b 3b 20 20 20 20 2d 20 72 65 re.;;.;; - re
0e30: 74 75 72 6e 73 20 23 28 20 66 6c 61 67 20 72 65 turns #( flag re
0e40: 73 75 6c 74 20 29 0a 3b 3b 0a 28 64 65 66 69 6e sult ).;;.(defin
0e50: 65 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d 72 e (api:execute-r
0e60: 65 71 75 65 73 74 73 20 64 62 73 74 72 75 63 74 equests dbstruct
0e70: 20 64 61 74 29 0a 20 20 28 68 61 6e 64 6c 65 2d dat). (handle-
0e80: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 exceptions. ex
0e90: 6e 0a 20 20 20 28 6c 65 74 20 28 28 63 61 6c 6c n. (let ((call
0ea0: 2d 63 68 61 69 6e 20 28 67 65 74 2d 63 61 6c 6c -chain (get-call
0eb0: 2d 63 68 61 69 6e 29 29 29 0a 20 20 20 20 20 28 -chain))). (
0ec0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
0ed0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
0ee0: 20 22 57 41 52 4e 49 4e 47 3a 20 61 70 69 3a 65 "WARNING: api:e
0ef0: 78 65 63 75 74 65 2d 72 65 71 75 65 73 74 73 20 xecute-requests
0f00: 72 65 63 65 69 76 65 64 20 61 6e 20 65 78 63 65 received an exce
0f10: 70 74 69 6f 6e 20 66 72 6f 6d 20 70 65 65 72 2c ption from peer,
0f20: 20 64 61 74 3d 22 20 64 61 74 29 0a 20 20 20 20 dat=" dat).
0f30: 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 (print-call-cha
0f40: 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f in (current-erro
0f50: 72 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 28 64 r-port)). (d
0f60: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
0f70: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
0f80: 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 28 28 " message: " ((
0f90: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
0fa0: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
0fb0: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
0fc0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 28 76 65 . (ve
0fd0: 63 74 6f 72 20 23 66 20 28 76 65 63 74 6f 72 20 ctor #f (vector
0fe0: 65 78 6e 20 63 61 6c 6c 2d 63 68 61 69 6e 20 64 exn call-chain d
0ff0: 61 74 29 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 at))) ;; return
1000: 73 6f 6d 65 20 73 74 75 66 66 20 66 6f 72 20 64 some stuff for d
1010: 65 62 75 67 20 69 66 20 61 6e 20 65 78 63 65 70 ebug if an excep
1020: 74 69 6f 6e 20 68 61 70 70 65 6e 73 0a 20 20 20 tion happens.
1030: 28 63 6f 6e 64 0a 20 20 20 20 28 28 6e 6f 74 20 (cond. ((not
1040: 28 76 65 63 74 6f 72 3f 20 64 61 74 29 29 20 20 (vector? dat))
1050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1060: 20 20 3b 3b 20 69 74 20 69 73 20 61 6e 20 65 72 ;; it is an er
1070: 72 6f 72 20 74 6f 20 6e 6f 74 20 72 65 63 65 69 ror to not recei
1080: 76 65 20 61 20 76 65 63 74 6f 72 0a 20 20 20 20 ve a vector.
1090: 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 (vector #f (vec
10a0: 74 6f 72 20 23 66 20 22 72 65 6d 6f 74 65 20 6d tor #f "remote m
10b0: 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 77 69 ust be called wi
10c0: 74 68 20 61 20 76 65 63 74 6f 72 22 29 29 29 0a th a vector"))).
10d0: 20 20 20 20 28 28 3e 20 2a 61 70 69 2d 70 72 6f ((> *api-pro
10e0: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
10f0: 6e 74 2a 20 32 30 29 20 3b 3b 20 32 30 29 0a 20 nt* 20) ;; 20).
1100: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1110: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
1120: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
1130: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
1140: 65 73 74 73 20 72 65 63 65 69 76 65 64 20 61 6e ests received an
1150: 20 6f 76 65 72 6c 6f 61 64 65 64 20 6d 65 73 73 overloaded mess
1160: 61 67 65 2e 22 29 0a 20 20 20 20 20 28 73 65 74 age."). (set
1170: 21 20 2a 73 65 72 76 65 72 2d 6f 76 65 72 6c 6f ! *server-overlo
1180: 61 64 65 64 2a 20 23 74 29 0a 20 20 20 20 20 28 aded* #t). (
1190: 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 74 6f vector #f (vecto
11a0: 72 20 23 66 20 27 6f 76 65 72 6c 6f 61 64 65 64 r #f 'overloaded
11b0: 29 29 29 20 3b 3b 20 74 68 65 20 69 6e 6e 65 72 ))) ;; the inner
11c0: 20 76 65 63 74 6f 72 20 69 73 20 77 68 61 74 20 vector is what
11d0: 67 65 74 73 20 72 65 74 75 72 6e 65 64 2e 20 6e gets returned. n
11e0: 6f 70 65 2c 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 ope, don't know
11f0: 77 68 79 2e 20 70 6c 65 61 73 65 20 72 65 66 61 why. please refa
1200: 63 74 6f 72 21 0a 20 20 20 20 28 65 6c 73 65 20 ctor!. (else
1210: 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c
1220: 6d 64 2d 69 6e 20 20 20 20 20 20 20 20 20 20 20 md-in
1230: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 (vector-ref dat
1240: 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 0)).
1250: 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 (cmd
1260: 20 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 3f (if (symbol?
1270: 20 63 6d 64 2d 69 6e 29 0a 09 09 09 09 20 20 20 cmd-in).....
1280: 63 6d 64 2d 69 6e 0a 09 09 09 09 20 20 20 28 73 cmd-in..... (s
1290: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d tring->symbol cm
12a0: 64 2d 69 6e 29 29 29 0a 20 20 20 20 20 20 20 20 d-in))).
12b0: 20 20 20 20 28 70 61 72 61 6d 73 20 20 20 20 20 (params
12c0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
12d0: 65 66 20 64 61 74 20 31 29 29 0a 20 20 20 20 20 ef dat 1)).
12e0: 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 74 20 (start-t
12f0: 20 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 (curre
1300: 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 nt-milliseconds)
1310: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 72 ). (r
1320: 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 20 20 20 eadonly-mode
1330: 20 28 64 62 72 3a 64 62 73 74 72 75 63 74 2d 72 (dbr:dbstruct-r
1340: 65 61 64 2d 6f 6e 6c 79 20 64 62 73 74 72 75 63 ead-only dbstruc
1350: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
1360: 28 72 65 61 64 6f 6e 6c 79 2d 63 6f 6d 6d 61 6e (readonly-comman
1370: 64 20 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 d (member cmd a
1380: 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 pi:read-only-que
1390: 72 69 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 ries)).
13a0: 20 20 20 28 77 72 69 74 65 63 6d 64 2d 69 6e 2d (writecmd-in-
13b0: 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 61 readonly-mode (a
13c0: 6e 64 20 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 nd readonly-mode
13d0: 20 28 6e 6f 74 20 72 65 61 64 6f 6e 6c 79 2d 63 (not readonly-c
13e0: 6f 6d 6d 61 6e 64 29 29 29 0a 20 20 20 20 20 20 ommand))).
13f0: 20 20 20 20 20 20 28 66 6f 6f 20 20 20 20 20 20 (foo
1400: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
1410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1430: 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 (common:telemet
1440: 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 ry-log (conc "ap
1450: 69 2d 69 6e 3a 22 28 2d 3e 73 74 72 69 6e 67 20 i-in:"(->string
1460: 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 cmd)).
1470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 79 pay
14a0: 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 6d 73 20 load: `((params
14b0: 2e 20 2c 70 61 72 61 6d 73 29 29 29 0a 20 20 20 . ,params))).
14c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 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: 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #t)).
1510: 20 28 72 65 73 20 20 20 20 0a 20 20 20 20 20 20 (res .
1520: 20 20 20 20 20 20 20 28 69 66 20 77 72 69 74 65 (if write
1530: 63 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d cmd-in-readonly-
1540: 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 20 mode.
1550: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 61 74 74 (conc "att
1560: 65 6d 70 74 20 74 6f 20 72 75 6e 20 77 72 69 74 empt to run writ
1570: 65 20 63 6f 6d 6d 61 6e 64 20 22 63 6d 64 22 20 e command "cmd"
1580: 6f 6e 20 61 20 72 65 61 64 2d 6f 6e 6c 79 20 64 on a read-only d
1590: 61 74 61 62 61 73 65 22 29 0a 20 20 20 20 20 20 atabase").
15a0: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 (case
15b0: 20 63 6d 64 0a 20 20 20 20 20 20 20 20 20 20 20 cmd.
15c0: 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d ;;======
15d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20 20 =========.
1600: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1610: 52 45 41 44 2f 57 52 49 54 45 20 51 55 45 52 49 READ/WRITE QUERI
1620: 45 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ES.
1630: 20 20 20 20 20 20 3b 3b 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 3d 3d 3d ================
1660: 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 20 20 20 20 20 20 =======..
1670: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
1680: 74 2d 6b 65 79 73 2d 77 72 69 74 65 29 20 20 20 t-keys-write)
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 (db:get-key
16b0: 73 20 64 62 73 74 72 75 63 74 29 29 20 3b 3b 20 s dbstruct)) ;;
16c0: 66 6f 72 63 65 20 61 20 64 75 6d 6d 79 20 22 77 force a dummy "w
16d0: 72 69 74 65 22 20 71 75 65 72 79 20 74 6f 20 66 rite" query to f
16e0: 6f 72 63 65 20 73 65 72 76 65 72 3b 20 66 6f 72 orce server; for
16f0: 20 64 65 62 75 67 20 69 6e 20 2d 72 65 70 6c 0a debug in -repl.
1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1710: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
1720: 20 20 20 20 20 20 20 3b 3b 20 53 45 52 56 45 52 ;; SERVER
1730: 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 S.
1740: 20 20 20 20 20 28 28 73 74 61 72 74 2d 73 65 72 ((start-ser
1750: 76 65 72 29 20 20 20 20 20 20 20 20 20 20 20 20 ver)
1760: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 73 (apply s
1770: 65 72 76 65 72 3a 6b 69 6e 64 2d 72 75 6e 20 70 erver:kind-run p
1780: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
1790: 20 20 20 20 20 20 20 20 20 20 20 28 28 6b 69 6c ((kil
17a0: 6c 2d 73 65 72 76 65 72 29 20 20 20 20 20 20 20 l-server)
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
17c0: 65 74 21 20 2a 73 65 72 76 65 72 2d 72 75 6e 2a et! *server-run*
17d0: 20 23 66 29 29 0a 0a 20 20 20 20 20 20 20 20 20 #f))..
17e0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 53 ;; TES
17f0: 54 53 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 TS..
1800: 20 20 20 20 20 20 20 3b 3b 28 28 74 65 73 74 2d ;;((test-
1810: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1820: 2d 62 79 2d 69 64 29 20 20 20 20 20 28 61 70 70 -by-id) (app
1830: 6c 79 20 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 ly mt:test-set-s
1840: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i
1850: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
1860: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
1870: 20 20 20 20 20 20 20 3b 3b 42 42 20 2d 20 63 6f ;;BB - co
1880: 6d 6d 65 6e 74 65 64 20 6f 75 74 20 61 62 6f 76 mmented out abov
1890: 65 20 62 65 63 61 75 73 65 20 69 74 20 77 61 73 e because it was
18a0: 20 63 61 6c 6c 69 6e 67 20 62 65 6c 6f 77 2c 20 calling below,
18b0: 65 76 65 6e 74 75 61 6c 6c 79 2c 20 69 6e 63 6f eventually, inco
18c0: 72 72 65 63 74 6c 79 20 28 64 62 73 74 72 75 63 rrectly (dbstruc
18d0: 74 20 70 61 73 73 65 64 20 74 6f 20 6d 74 3a 74 t passed to mt:t
18e0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
18f0: 61 74 75 73 2d 62 79 2d 69 64 2c 20 77 68 69 63 atus-by-id, whic
1900: 68 20 70 72 65 76 69 6f 73 6c 79 20 64 69 64 20 h previosly did
1910: 6d 6f 72 65 2c 20 62 75 74 20 6e 6f 77 20 6f 6e more, but now on
1920: 6c 79 20 70 61 73 73 65 73 20 74 68 72 75 20 74 ly passes thru t
1930: 6f 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 o db:set-state-s
1940: 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 tatus-and-roll-u
1950: 70 2d 69 74 65 6d 73 2e 0a 20 20 20 20 20 20 20 p-items..
1960: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 ((te
1970: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
1980: 74 75 73 2d 62 79 2d 69 64 29 0a 0a 20 20 20 20 tus-by-id)..
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a0: 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 62 3a 73 ;; (define (db:s
19b0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
19c0: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
19d0: 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 s dbstruct run-i
19e0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
19f0: 2d 70 61 74 68 20 73 74 61 74 65 20 73 74 61 74 -path state stat
1a00: 75 73 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 us comment).
1a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a20: 28 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 (db:set-state-st
1a30: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1a40: 2d 69 74 65 6d 73 0a 20 20 20 20 20 20 20 20 20 -items.
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 64 62 73 74 dbst
1a60: 72 75 63 74 0a 20 20 20 20 20 20 20 20 20 20 20 ruct.
1a70: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d (list-
1a80: 72 65 66 20 70 61 72 61 6d 73 20 30 29 20 3b 20 ref params 0) ;
1a90: 72 75 6e 2d 69 64 0a 20 20 20 20 20 20 20 20 20 run-id.
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
1ab0: 74 2d 72 65 66 20 70 61 72 61 6d 73 20 31 29 20 t-ref params 1)
1ac0: 3b 20 74 65 73 74 2d 6e 61 6d 65 0a 20 20 20 20 ; test-name.
1ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ae0: 20 23 66 20 20 20 20 20 20 20 20 20 20 20 20 20 #f
1af0: 20 20 20 20 20 3b 20 69 74 65 6d 2d 70 61 74 68 ; item-path
1b00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b10: 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 (list-ref
1b20: 70 61 72 61 6d 73 20 32 29 20 3b 20 73 74 61 74 params 2) ; stat
1b30: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
1b40: 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 (list-ref
1b50: 20 70 61 72 61 6d 73 20 33 29 20 3b 20 73 74 61 params 3) ; sta
1b60: 74 75 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 tus.
1b70: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 (list-r
1b80: 65 66 20 70 61 72 61 6d 73 20 34 29 20 3b 20 63 ef params 4) ; c
1b90: 6f 6d 6d 65 6e 74 0a 20 20 20 20 20 20 20 20 20 omment.
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 )).
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1bd0: 20 20 20 20 20 20 28 28 64 65 6c 65 74 65 2d 74 ((delete-t
1be0: 65 73 74 2d 72 65 63 6f 72 64 73 29 20 20 20 20 est-records)
1bf0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
1c00: 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 db:delete-test-r
1c10: 65 63 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 ecords dbstruct
1c20: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 65 ((de
1c40: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
1c50: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 20 28 -test-records) (
1c60: 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d apply db:delete-
1c70: 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 old-deleted-test
1c80: 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 63 -records dbstruc
1c90: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1cb0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
1cc0: 74 61 74 75 73 29 20 20 20 20 20 20 20 20 20 20 tatus)
1cd0: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
1ce0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1cf0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
1d00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1d10: 20 20 20 20 20 20 28 28 74 65 73 74 2d 73 65 74 ((test-set
1d20: 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 -top-process-pid
1d30: 29 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 ) (apply
1d40: 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d db:test-set-top-
1d50: 70 72 6f 63 65 73 73 2d 70 69 64 20 64 62 73 74 process-pid dbst
1d60: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 28 28 73 65 74 2d 73 74 61 74 65 2d 73 74 61 ((set-state-sta
1d90: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
1da0: 69 74 65 6d 73 29 20 28 61 70 70 6c 79 20 64 62 items) (apply db
1db0: 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 :set-state-statu
1dc0: 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 s-and-roll-up-it
1dd0: 65 6d 73 20 64 62 73 74 72 75 63 74 20 70 61 72 ems dbstruct par
1de0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
1df0: 20 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 73 ((set-s
1e00: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
1e10: 72 6f 6c 6c 2d 75 70 2d 72 75 6e 29 20 28 61 70 roll-up-run) (ap
1e20: 70 6c 79 20 64 62 3a 73 65 74 2d 73 74 61 74 65 ply db:set-state
1e30: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
1e40: 2d 75 70 2d 72 75 6e 20 64 62 73 74 72 75 63 74 -up-run dbstruct
1e50: 20 70 61 72 61 6d 73 29 29 20 0a 20 20 20 20 20 params)) .
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1e70: 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 top-test-set-per
1e80: 2d 70 66 2d 63 6f 75 6e 74 73 29 20 20 20 20 20 -pf-counts)
1e90: 20 28 61 70 70 6c 79 20 64 62 3a 74 6f 70 2d 74 (apply db:top-t
1ea0: 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 2d 63 est-set-per-pf-c
1eb0: 6f 75 6e 74 73 20 64 62 73 74 72 75 63 74 20 70 ounts dbstruct p
1ec0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
1ed0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
1ee0: 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c t-set-archive-bl
1ef0: 6f 63 6b 2d 69 64 29 20 20 20 20 20 20 20 28 61 ock-id) (a
1f00: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74 pply db:test-set
1f10: 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 -archive-block-i
1f20: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
1f30: 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 s))..
1f40: 20 20 20 20 20 20 20 20 3b 3b 20 52 55 4e 53 0a ;; RUNS.
1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f60: 20 20 20 28 28 72 65 67 69 73 74 65 72 2d 72 75 ((register-ru
1f70: 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n)
1f80: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 72 65 67 (apply db:reg
1f90: 69 73 74 65 72 2d 72 75 6e 20 64 62 73 74 72 75 ister-run dbstru
1fa0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1fc0: 28 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 (set-tests-state
1fd0: 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 -status) (
1fe0: 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 74 65 73 apply db:set-tes
1ff0: 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 ts-state-status
2000: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2010: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2020: 20 20 20 20 20 28 28 64 65 6c 65 74 65 2d 72 75 ((delete-ru
2030: 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n)
2040: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 64 (apply db:d
2050: 65 6c 65 74 65 2d 72 75 6e 20 64 62 73 74 72 75 elete-run dbstru
2060: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2080: 28 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e (lock/unlock-run
2090: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ) (
20a0: 61 70 70 6c 79 20 64 62 3a 6c 6f 63 6b 2f 75 6e apply db:lock/un
20b0: 6c 6f 63 6b 2d 72 75 6e 20 64 62 73 74 72 75 63 lock-run dbstruc
20c0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
20e0: 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 update-run-event
20f0: 5f 74 69 6d 65 29 20 20 20 20 20 20 20 20 28 61 _time) (a
2100: 70 70 6c 79 20 64 62 3a 75 70 64 61 74 65 2d 72 pply db:update-r
2110: 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 64 62 un-event_time db
2120: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 20 28 28 75 70 64 61 74 65 2d 72 75 6e 2d ((update-run-
2150: 73 74 61 74 73 29 20 20 20 20 20 20 20 20 20 20 stats)
2160: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 75 70 64 (apply db:upd
2170: 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 ate-run-stats db
2180: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 28 28 73 65 74 2d 76 61 72 29 20 20 20 ((set-var)
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21c0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 (apply db:set
21d0: 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 70 61 -var dbstruct pa
21e0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
21f0: 20 20 20 20 20 20 20 20 20 20 28 28 69 6e 63 2d ((inc-
2200: 76 61 72 29 20 20 20 20 20 20 20 20 20 20 20 20 var)
2210: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
2220: 20 64 62 3a 69 6e 63 2d 76 61 72 20 64 62 73 74 db:inc-var dbst
2230: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 ruct params))...
2240: 20 20 20 28 28 64 65 63 2d 76 61 72 29 20 20 20 ((dec-var)
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2260: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 64 65 63 (apply db:dec
2270: 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 70 61 -var dbstruct pa
2280: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
2290: 20 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 2d ((del-
22a0: 76 61 72 29 20 20 20 20 20 20 20 20 20 20 20 20 var)
22b0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
22c0: 20 64 62 3a 64 65 6c 2d 76 61 72 20 64 62 73 74 db:del-var dbst
22d0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 ruct params))...
22e0: 20 20 20 28 28 61 64 64 2d 76 61 72 29 20 20 20 ((add-var)
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2300: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 61 64 64 (apply db:add
2310: 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 70 61 -var dbstruct pa
2320: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
2330: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 53 54 ;; ST
2340: 45 50 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 EPS.
2350: 20 20 20 20 20 20 20 28 28 74 65 73 74 73 74 65 ((testste
2360: 70 2d 73 65 74 2d 73 74 61 74 75 73 21 29 20 20 p-set-status!)
2370: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2380: 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
2390: 61 74 75 73 21 20 64 62 73 74 72 75 63 74 20 70 atus! dbstruct p
23a0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
23b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 64 65 6c ((del
23c0: 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 ete-steps-for-te
23d0: 73 74 21 29 20 20 20 20 20 20 20 20 28 61 70 70 st!) (app
23e0: 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 73 74 65 ly db:delete-ste
23f0: 70 73 2d 66 6f 72 2d 74 65 73 74 21 20 64 62 73 ps-for-test! dbs
2400: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2420: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2430: 20 20 20 20 20 20 3b 3b 20 54 45 53 54 20 44 41 ;; TEST DA
2440: 54 41 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 TA.
2450: 20 20 20 20 20 20 28 28 74 65 73 74 2d 64 61 74 ((test-dat
2460: 61 2d 72 6f 6c 6c 75 70 29 20 20 20 20 20 20 20 a-rollup)
2470: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2480: 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 test-data-rollup
2490: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
24a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
24b0: 20 20 20 20 20 20 28 28 63 73 76 2d 3e 74 65 73 ((csv->tes
24c0: 74 2d 64 61 74 61 29 20 20 20 20 20 20 20 20 20 t-data)
24d0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
24e0: 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 csv->test-data d
24f0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2500: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2510: 20 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20 ;; MISC.
2520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2530: 28 28 73 79 6e 63 2d 69 6e 6d 65 6d 2d 3e 64 62 ((sync-inmem->db
2540: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2550: 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 63 (let ((run-id (c
2560: 61 72 20 70 61 72 61 6d 73 29 29 29 0a 20 20 20 ar params))).
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a0: 20 20 28 64 62 3a 73 79 6e 63 2d 74 6f 75 63 68 (db:sync-touch
25b0: 65 64 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d ed dbstruct run-
25c0: 69 64 20 66 6f 72 63 65 2d 73 79 6e 63 3a 20 23 id force-sync: #
25d0: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
25e0: 20 20 20 20 20 20 20 20 28 28 6d 61 72 6b 2d 69 ((mark-i
25f0: 6e 63 6f 6d 70 6c 65 74 65 29 20 20 20 20 20 20 ncomplete)
2600: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2610: 62 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d b:find-and-mark-
2620: 69 6e 63 6f 6d 70 6c 65 74 65 20 64 62 73 74 72 incomplete dbstr
2630: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2650: 28 28 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 ((create-all-tri
2660: 67 67 65 72 73 29 20 20 20 20 20 20 20 20 20 20 ggers)
2670: 28 64 62 3a 63 72 65 61 74 65 2d 61 6c 6c 2d 74 (db:create-all-t
2680: 72 69 67 67 65 72 73 20 64 62 73 74 72 75 63 74 riggers dbstruct
2690: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
26a0: 20 20 20 20 20 20 28 28 64 72 6f 70 2d 61 6c 6c ((drop-all
26b0: 2d 74 72 69 67 67 65 72 73 29 20 20 20 20 20 20 -triggers)
26c0: 20 20 20 20 20 20 28 64 62 3a 64 72 6f 70 2d 61 (db:drop-a
26d0: 6c 6c 2d 74 72 69 67 67 65 72 73 20 64 62 73 74 ll-triggers dbst
26e0: 72 75 63 74 29 29 20 0a 20 20 20 20 20 20 20 20 ruct)) .
26f0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
2700: 53 54 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 STMETA.
2710: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
2720: 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 29 meta-add-record)
2730: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2740: 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 :testmeta-add-re
2750: 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 70 61 cord dbstruct pa
2760: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
2770: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
2780: 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c meta-update-fiel
2790: 64 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 d) (apply db
27a0: 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 :testmeta-update
27b0: 2d 66 69 65 6c 64 20 64 62 73 74 72 75 63 74 20 -field dbstruct
27c0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
27e0: 74 2d 74 65 73 74 73 2d 74 61 67 73 29 20 20 20 t-tests-tags)
27f0: 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 (db:get
2800: 2d 74 65 73 74 73 2d 74 61 67 73 20 64 62 73 74 -tests-tags dbst
2810: 72 75 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 ruct))..
2820: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 ;; TA
2830: 53 4b 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 SKS.
2840: 20 20 20 20 20 20 20 28 28 74 61 73 6b 73 2d 61 ((tasks-a
2850: 64 64 29 20 20 20 20 20 20 20 20 20 20 20 20 20 dd)
2860: 20 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 (apply tasks
2870: 3a 61 64 64 20 64 62 73 74 72 75 63 74 20 70 61 :add dbstruct pa
2880: 72 61 6d 73 29 29 20 20 20 0a 20 20 20 20 20 20 rams)) .
2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
28a0: 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 asks-set-state-g
28b0: 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 29 20 iven-param-key)
28c0: 28 61 70 70 6c 79 20 74 61 73 6b 73 3a 73 65 74 (apply tasks:set
28d0: 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 -state-given-par
28e0: 61 6d 2d 6b 65 79 20 64 62 73 74 72 75 63 74 20 am-key dbstruct
28f0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2900: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 ((ta
2910: 73 6b 73 2d 67 65 74 2d 6c 61 73 74 29 20 20 20 sks-get-last)
2920: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2930: 74 61 73 6b 73 3a 67 65 74 2d 6c 61 73 74 20 64 tasks:get-last d
2940: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2950: 0a 0a 09 09 20 20 20 3b 3b 20 4e 4f 20 53 59 4e .... ;; NO SYN
2960: 43 20 44 42 0a 09 09 20 20 20 28 28 6e 6f 2d 73 C DB... ((no-s
2970: 79 6e 63 2d 73 65 74 29 20 20 20 20 20 20 20 20 ync-set)
2980: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2990: 3a 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 20 20 20 :no-sync-set
29a0: 20 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 *no-sync-db
29b0: 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 * params))...
29c0: 28 28 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 ((no-sync-get/de
29d0: 66 61 75 6c 74 29 20 20 20 20 20 20 20 28 61 70 fault) (ap
29e0: 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 67 ply db:no-sync-g
29f0: 65 74 2f 64 65 66 61 75 6c 74 20 2a 6e 6f 2d 73 et/default *no-s
2a00: 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 ync-db* params))
2a10: 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d ... ((no-sync-
2a20: 64 65 6c 21 29 20 20 20 20 20 20 20 20 20 20 20 del!)
2a30: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d (apply db:no-
2a40: 73 79 6e 63 2d 64 65 6c 21 20 20 20 20 20 20 20 sync-del!
2a50: 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 *no-sync-db* pa
2a60: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f rams))... ((no
2a70: 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 29 20 -sync-get-lock)
2a80: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2a90: 64 62 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c db:no-sync-get-l
2aa0: 6f 63 6b 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d ock *no-sync-
2ab0: 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 db* params))...
2ac0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2ad0: 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 0a ;; ARCHIVES.
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d ;; ((archive-
2b00: 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 29 get-allocations)
2b10: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
2b20: 20 20 20 20 20 20 20 28 28 61 72 63 68 69 76 65 ((archive
2b30: 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 29 20 -register-disk)
2b40: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 61 72 (apply db:ar
2b50: 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 64 chive-register-d
2b60: 69 73 6b 20 64 62 73 74 72 75 63 74 20 70 61 72 isk dbstruct par
2b70: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2b80: 20 20 20 20 20 20 20 20 20 28 28 61 72 63 68 69 ((archi
2b90: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 ve-register-bloc
2ba0: 6b 2d 6e 61 6d 65 29 28 61 70 70 6c 79 20 64 62 k-name)(apply db
2bb0: 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 :archive-registe
2bc0: 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 64 62 73 r-block-name dbs
2bd0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bf0: 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d 61 ;; ((archive-a
2c00: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
2c10: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29 e/area-to-block)
2c20: 28 61 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76 (apply db:archiv
2c30: 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 e-allocate-tests
2c40: 75 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f uite/area-to-blo
2c50: 63 6b 20 64 62 73 74 72 75 63 74 20 62 6c 6f 63 ck dbstruct bloc
2c60: 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e k-id testsuite-n
2c70: 61 6d 65 20 61 72 65 61 6b 65 79 29 29 0a 0a 20 ame areakey))..
2c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c90: 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============
2ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20 ==========.
2ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2cf0: 20 52 45 41 44 20 4f 4e 4c 59 20 51 55 45 52 49 READ ONLY QUERI
2d00: 45 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ES.
2d10: 20 20 20 20 20 20 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
2d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d70: 20 20 20 3b 3b 20 4b 45 59 53 0a 20 20 20 20 20 ;; KEYS.
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2d90: 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 get-key-val-pair
2da0: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s)
2db0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6b (apply db:get-k
2dc0: 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 62 73 ey-val-pairs dbs
2dd0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2df0: 20 20 28 28 67 65 74 2d 6b 65 79 73 29 20 20 20 ((get-keys)
2e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e10: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 (db:get-key
2e20: 73 20 64 62 73 74 72 75 63 74 29 29 0a 20 20 20 s dbstruct)).
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e40: 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 29 20 ((get-key-vals)
2e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e60: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
2e70: 2d 6b 65 79 2d 76 61 6c 73 20 64 62 73 74 72 75 -key-vals dbstru
2e80: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2ea0: 28 67 65 74 2d 74 61 72 67 65 74 29 20 20 20 20 (get-target)
2eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ec0: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
2ed0: 74 61 72 67 65 74 20 64 62 73 74 72 75 63 74 20 target dbstruct
2ee0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
2f00: 74 2d 74 61 72 67 65 74 73 29 20 20 20 20 20 20 t-targets)
2f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2f20: 64 62 3a 67 65 74 2d 74 61 72 67 65 74 73 20 64 db:get-targets d
2f30: 62 73 74 72 75 63 74 29 29 0a 0a 20 20 20 20 20 bstruct))..
2f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2f50: 20 41 52 43 48 49 56 45 53 0a 20 20 20 20 20 20 ARCHIVES.
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
2f70: 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 65 2d est-get-archive-
2f80: 62 6c 6f 63 6b 2d 69 6e 66 6f 29 20 20 20 20 20 block-info)
2f90: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 (apply db:test-g
2fa0: 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b et-archive-block
2fb0: 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20 70 -info dbstruct p
2fc0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
2fd0: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2ff0: 3b 20 54 45 53 54 53 0a 20 20 20 20 20 20 20 20 ; TESTS.
3000: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
3010: 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 t-toplevel-num-i
3020: 74 65 6d 73 29 20 20 20 20 20 20 20 20 20 28 61 tems) (a
3030: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 74 6f 70 pply db:test-top
3040: 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20 level-num-items
3050: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3060: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3070: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 2d ((get-test-
3080: 69 6e 66 6f 2d 62 79 2d 69 64 29 09 20 20 20 20 info-by-id).
3090: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
30a0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
30b0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
30c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
30d0: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 ((test-get
30e0: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
30f0: 74 2d 69 64 29 20 20 20 20 28 61 70 70 6c 79 20 t-id) (apply
3100: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund
3110: 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 ir-from-test-id
3120: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3130: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3140: 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 ((get-count
3150: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 -tests-running-f
3160: 6f 72 2d 74 65 73 74 6e 61 6d 65 29 20 28 61 70 or-testname) (ap
3170: 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 ply db:get-count
3180: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 -tests-running-f
3190: 6f 72 2d 74 65 73 74 6e 61 6d 65 20 64 62 73 74 or-testname dbst
31a0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
31b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31c0: 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 ((get-count-tes
31d0: 74 73 2d 72 75 6e 6e 69 6e 67 29 20 20 20 20 20 ts-running)
31e0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
31f0: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
3200: 6e 6e 69 6e 67 20 64 62 73 74 72 75 63 74 20 70 nning dbstruct p
3210: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3220: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3230: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
3240: 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 ning-in-jobgroup
3250: 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d ) (apply db:get-
3260: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
3270: 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 ing-in-jobgroup
3280: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3290: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
32a0: 20 20 20 20 20 3b 3b 20 28 28 64 65 6c 65 74 65 ;; ((delete
32b0: 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 -test-step-recor
32c0: 64 73 29 20 20 20 20 20 20 20 20 28 61 70 70 6c ds) (appl
32d0: 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 y db:delete-test
32e0: 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 62 -step-records db
32f0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3310: 20 20 20 3b 3b 20 28 28 67 65 74 2d 70 72 65 76 ;; ((get-prev
3320: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 ious-test-run-re
3330: 63 6f 72 64 29 20 20 20 20 28 61 70 70 6c 79 20 cord) (apply
3340: 64 62 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d db:get-previous-
3350: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 test-run-record
3360: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3370: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3380: 20 20 20 20 20 28 28 67 65 74 2d 6d 61 74 63 68 ((get-match
3390: 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 ing-previous-tes
33a0: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 29 28 61 t-run-records)(a
33b0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 6d 61 74 63 pply db:get-matc
33c0: 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 hing-previous-te
33d0: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 64 st-run-records d
33e0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
33f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3400: 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 6c ((test-get-l
3410: 6f 67 66 69 6c 65 2d 69 6e 66 6f 29 20 20 20 20 ogfile-info)
3420: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3430: 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c :test-get-logfil
3440: 65 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20 e-info dbstruct
3450: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3460: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 ((te
3470: 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 st-get-records-f
3480: 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 29 20 20 or-index-file)
3490: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 (apply db:test-g
34a0: 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 et-records-for-i
34b0: 6e 64 65 78 2d 66 69 6c 65 20 64 62 73 74 72 75 ndex-file dbstru
34c0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
34e0: 28 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 (get-testinfo-st
34f0: 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 ate-status)
3500: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3510: 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 testinfo-state-s
3520: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 tatus dbstruct p
3530: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3540: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
3550: 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 t-get-top-proces
3560: 73 2d 70 69 64 29 20 20 20 20 20 20 20 20 28 61 s-pid) (a
3570: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 pply db:test-get
3580: 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 -top-process-pid
3590: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
35a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
35b0: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 ((test-get
35c0: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d -paths-matching-
35d0: 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d keynames-target-
35e0: 6e 65 77 29 20 28 61 70 70 6c 79 20 64 62 3a 74 new) (apply db:t
35f0: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
3600: 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d tching-keynames-
3610: 74 61 72 67 65 74 2d 6e 65 77 20 64 62 73 74 72 target-new dbstr
3620: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 28 28 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f ((get-prereqs-no
3650: 74 2d 6d 65 74 29 20 20 20 20 20 20 20 20 20 20 t-met)
3660: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3670: 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 -prereqs-not-met
3680: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3690: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
36a0: 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 6e ((get-coun
36b0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
36c0: 66 6f 72 2d 72 75 6e 2d 69 64 29 20 28 61 70 70 for-run-id) (app
36d0: 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d ly db:get-count-
36e0: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f tests-running-fo
36f0: 72 2d 72 75 6e 2d 69 64 20 64 62 73 74 72 75 63 r-run-id dbstruc
3700: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3720: 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 get-not-complete
3730: 64 2d 63 6e 74 29 20 20 20 20 20 20 20 20 20 20 d-cnt)
3740: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6e (apply db:get-n
3750: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
3760: 20 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d dbstruct param
3770: 73 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 s)) .
3780: 20 20 20 20 20 20 20 20 3b 3b 20 28 28 73 79 6e ;; ((syn
3790: 63 68 61 73 68 2d 67 65 74 29 20 20 20 20 20 20 chash-get)
37a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
37b0: 70 70 6c 79 20 73 79 6e 63 68 61 73 68 3a 73 65 pply synchash:se
37c0: 72 76 65 72 2d 67 65 74 20 64 62 73 74 72 75 63 rver-get dbstruc
37d0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
37f0: 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 get-raw-run-stat
3800: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s)
3810: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 (apply db:get-r
3820: 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73 aw-run-stats dbs
3830: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 truct params))..
3840: 09 20 20 20 28 28 67 65 74 2d 74 65 73 74 2d 74 . ((get-test-t
3850: 69 6d 65 73 29 20 20 20 20 20 20 20 20 20 20 20 imes)
3860: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3870: 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 20 :get-test-times
3880: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3890: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )..
38a0: 20 20 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 ;; RUNS.
38b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38c0: 20 28 28 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 29 ((get-run-info)
38d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38e0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 (apply db:get-r
38f0: 75 6e 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 un-info dbstruct
3900: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3910: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
3920: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 20 20 et-run-status)
3930: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3940: 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 ply db:get-run-s
3950: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 tatus dbstruct p
3960: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3970: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3980: 2d 72 75 6e 2d 73 74 61 74 65 29 20 20 20 20 20 -run-state)
3990: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
39a0: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 61 y db:get-run-sta
39b0: 74 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61 te dbstruct para
39c0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
39d0: 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 72 75 ((set-ru
39e0: 6e 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20 n-status)
39f0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3a00: 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 b:set-run-status
3a10: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3a20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3a30: 20 20 20 20 20 20 28 28 73 65 74 2d 72 75 6e 2d ((set-run-
3a40: 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 09 state-status) .
3a50: 09 09 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 .. (apply db:set
3a60: 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 -run-state-statu
3a70: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3a80: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3a90: 20 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d ((update-
3aa0: 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c tesdata-on-repil
3ab0: 63 61 74 65 2d 64 62 29 20 28 61 70 70 6c 79 20 cate-db) (apply
3ac0: 64 62 3a 75 70 64 61 74 65 2d 74 65 73 64 61 74 db:update-tesdat
3ad0: 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 2d 64 a-on-repilcate-d
3ae0: 62 20 20 64 62 73 74 72 75 63 74 20 70 61 72 61 b dbstruct para
3af0: 6d 73 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 ms)) .
3b00: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 ((get-t
3b10: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 29 20 20 20 ests-for-run)
3b20: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3b30: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
3b40: 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 70 61 -run dbstruct pa
3b50: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3b60: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3b70: 74 65 73 74 2d 69 64 29 20 20 20 20 20 20 20 20 test-id)
3b80: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
3b90: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 db:get-test-id
3ba0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3bb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3bc0: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 73 ((get-tests
3bd0: 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 -for-run-mindata
3be0: 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 ) (apply db:g
3bf0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
3c00: 2d 6d 69 6e 64 61 74 61 20 64 62 73 74 72 75 63 -mindata dbstruc
3c10: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
3c30: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 ((get-tests-for
3c40: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 29 20 20 -runs-mindata)
3c50: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3c60: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 ests-for-runs-mi
3c70: 6e 64 61 74 61 20 64 62 73 74 72 75 63 74 20 70 ndata dbstruct p
3c80: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3c90: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3ca0: 2d 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 -runs)
3cb0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
3cc0: 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 y db:get-runs db
3cd0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cf0: 20 20 20 28 28 73 69 6d 70 6c 65 2d 67 65 74 2d ((simple-get-
3d00: 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 20 runs)
3d10: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 69 6d (apply db:sim
3d20: 70 6c 65 2d 67 65 74 2d 72 75 6e 73 20 64 62 73 ple-get-runs dbs
3d30: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d50: 20 20 28 28 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 ((get-num-runs
3d60: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3d70: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3d80: 6e 75 6d 2d 72 75 6e 73 20 64 62 73 74 72 75 63 num-runs dbstruc
3d90: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3db0: 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d get-runs-cnt-by-
3dc0: 70 61 74 74 29 20 20 20 20 20 20 20 20 20 28 61 patt) (a
3dd0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 pply db:get-runs
3de0: 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 64 62 73 -cnt-by-patt dbs
3df0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e10: 20 20 28 28 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d ((get-all-run-
3e20: 69 64 73 29 20 20 20 20 20 20 20 20 20 20 20 20 ids)
3e30: 20 20 28 64 62 3a 67 65 74 2d 61 6c 6c 2d 72 75 (db:get-all-ru
3e40: 6e 2d 69 64 73 20 64 62 73 74 72 75 63 74 29 29 n-ids dbstruct))
3e50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3e60: 20 20 20 20 28 28 67 65 74 2d 70 72 65 76 2d 72 ((get-prev-r
3e70: 75 6e 2d 69 64 73 29 20 20 20 20 20 20 20 20 20 un-ids)
3e80: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
3e90: 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 64 t-prev-run-ids d
3ea0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3eb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3ec0: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 69 64 ((get-run-id
3ed0: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 s-matching-targe
3ee0: 74 29 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 t) (apply db:ge
3ef0: 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 t-run-ids-matchi
3f00: 6e 67 2d 74 61 72 67 65 74 20 64 62 73 74 72 75 ng-target dbstru
3f10: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3f30: 28 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 (get-runs-by-pat
3f40: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 t) (
3f50: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3f60: 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 s-by-patt dbstru
3f70: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3f90: 28 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 (get-run-name-fr
3fa0: 6f 6d 2d 69 64 29 20 20 20 20 20 20 20 20 20 28 om-id) (
3fb0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3fc0: 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 64 62 -name-from-id db
3fd0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ff0: 20 20 20 28 28 67 65 74 2d 6d 61 69 6e 2d 72 75 ((get-main-ru
4000: 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 20 n-stats)
4010: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
4020: 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 -main-run-stats
4030: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
4040: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4050: 20 20 20 20 20 28 28 67 65 74 2d 76 61 72 29 20 ((get-var)
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4070: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
4080: 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 et-var dbstruct
4090: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
40a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
40b0: 74 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20 t-run-stats)
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
40d0: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 ly db:get-run-st
40e0: 61 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72 ats dbstruct par
40f0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
4100: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
4110: 75 6e 2d 74 69 6d 65 73 29 20 20 20 20 20 20 20 un-times)
4120: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
4130: 64 62 3a 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 db:get-run-times
4140: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
4150: 29 29 20 0a 0a 20 20 20 20 20 20 20 20 20 20 20 )) ..
4160: 20 20 20 20 20 20 20 20 3b 3b 20 53 54 45 50 53 ;; STEPS
4170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4180: 20 20 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d ((get-steps-
4190: 64 61 74 61 29 20 20 20 20 20 20 20 20 20 20 20 data)
41a0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
41b0: 74 2d 73 74 65 70 73 2d 64 61 74 61 20 64 62 73 t-steps-data dbs
41c0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
41d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41e0: 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d 66 6f ((get-steps-fo
41f0: 72 2d 74 65 73 74 29 20 20 20 20 20 20 20 20 20 r-test)
4200: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
4210: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 steps-for-test d
4220: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
4230: 0a 09 09 20 20 20 28 28 67 65 74 2d 73 74 65 70 ... ((get-step
4240: 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 20 s-info-by-id)
4250: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4260: 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62 get-steps-info-b
4270: 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 y-id dbstruct pa
4280: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
4290: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
42a0: 53 54 20 44 41 54 41 0a 20 20 20 20 20 20 20 20 ST DATA.
42b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 72 65 61 ((rea
42c0: 64 2d 74 65 73 74 2d 64 61 74 61 29 20 20 20 20 d-test-data)
42d0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
42e0: 79 20 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 y db:read-test-d
42f0: 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 ata dbstruct par
4300: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
4310: 20 20 20 20 20 20 20 20 20 28 28 72 65 61 64 2d ((read-
4320: 74 65 73 74 2d 64 61 74 61 2a 29 20 20 20 20 20 test-data*)
4330: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
4340: 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 db:read-test-dat
4350: 61 2a 20 64 62 73 74 72 75 63 74 20 70 61 72 61 a* dbstruct para
4360: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
4370: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 64 61 ((get-da
4380: 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 ta-info-by-id)
4390: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
43a0: 62 3a 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d b:get-data-info-
43b0: 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 by-id dbstruct p
43c0: 61 72 61 6d 73 29 29 20 0a 0a 20 20 20 20 20 20 arams)) ..
43d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
43e0: 4d 49 53 43 0a 20 20 20 20 20 20 20 20 20 20 20 MISC.
43f0: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6c 61 ((get-la
4400: 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 29 20 test-host-load)
4410: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
4420: 62 3a 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f 73 b:get-latest-hos
4430: 74 2d 6c 6f 61 64 20 64 62 73 74 72 75 63 74 20 t-load dbstruct
4440: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
4450: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 68 61 ((ha
4460: 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 29 ve-incompletes?)
4470: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
4480: 6c 79 20 64 62 3a 68 61 76 65 2d 69 6e 63 6f 6d ly db:have-incom
4490: 70 6c 65 74 65 73 3f 20 64 62 73 74 72 75 63 74 pletes? dbstruct
44a0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c ((l
44c0: 6f 67 69 6e 29 20 20 20 20 20 20 20 20 20 20 20 ogin)
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
44e0: 70 6c 79 20 64 62 3a 6c 6f 67 69 6e 20 64 62 73 ply db:login dbs
44f0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4510: 20 20 28 28 67 65 6e 65 72 61 6c 2d 63 61 6c 6c ((general-call
4520: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4530: 20 20 28 6c 65 74 20 28 28 73 74 6d 74 6e 61 6d (let ((stmtnam
4540: 65 20 20 20 28 63 61 72 20 70 61 72 61 6d 73 29 e (car params)
4550: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4580: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d (run-
4590: 69 64 20 20 20 20 20 28 63 61 64 72 20 70 61 72 id (cadr par
45a0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
45b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
45e0: 72 65 61 6c 70 61 72 61 6d 73 20 28 63 64 64 72 realparams (cddr
45f0: 20 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 params))).
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c (db:general-call
4640: 20 64 62 73 74 72 75 63 74 20 73 74 6d 74 6e 61 dbstruct stmtna
4650: 6d 65 20 72 65 61 6c 70 61 72 61 6d 73 29 29 29 me realparams)))
4660: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4670: 20 20 20 20 28 28 73 64 62 2d 71 72 79 29 20 20 ((sdb-qry)
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4690: 20 20 20 20 28 61 70 70 6c 79 20 73 64 62 3a 71 (apply sdb:q
46a0: 72 79 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ry params)).
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
46c0: 28 70 69 6e 67 29 20 20 20 20 20 20 20 20 20 20 (ping)
46d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
46e0: 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d current-process-
46f0: 69 64 29 29 0a 09 09 20 20 20 28 28 67 65 74 2d id))... ((get-
4700: 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d 69 changed-record-i
4710: 64 73 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 ds) (apply
4720: 20 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d db:get-changed-
4730: 72 65 63 6f 72 64 2d 69 64 73 20 64 62 73 74 72 record-ids dbstr
4740: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 uct params))...
4750: 20 20 28 28 67 65 74 2d 72 75 6e 2d 72 65 63 6f ((get-run-reco
4760: 72 64 2d 69 64 73 29 20 09 20 20 20 28 61 70 70 rd-ids) . (app
4770: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 72 65 ly db:get-run-re
4780: 63 6f 72 64 2d 69 64 73 20 64 62 73 74 72 75 63 cord-ids dbstruc
4790: 74 20 70 61 72 61 6d 73 29 29 09 0a 20 20 20 20 t params))..
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
47b0: 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 20 ; TESTMETA.
47c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
47d0: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 testmeta-get-rec
47e0: 6f 72 64 29 20 20 20 20 20 20 20 28 61 70 70 6c ord) (appl
47f0: 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 y db:testmeta-ge
4800: 74 2d 72 65 63 6f 72 64 20 64 62 73 74 72 75 63 t-record dbstruc
4810: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
4830: 3b 20 54 41 53 4b 53 20 0a 20 20 20 20 20 20 20 ; TASKS .
4840: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 66 69 ((fi
4850: 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 nd-task-queue-re
4860: 63 6f 72 64 73 29 20 20 20 28 61 70 70 6c 79 20 cords) (apply
4870: 74 61 73 6b 73 3a 66 69 6e 64 2d 74 61 73 6b 2d tasks:find-task-
4880: 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 64 62 queue-records db
4890: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
48a0: 09 09 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 .. (else...
48b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
48c0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
48d0: 74 2a 20 22 45 52 52 4f 52 3a 20 62 61 64 20 61 t* "ERROR: bad a
48e0: 70 69 20 63 61 6c 6c 20 22 20 63 6d 64 29 0a 09 pi call " cmd)..
48f0: 09 20 20 20 20 28 63 6f 6e 63 20 22 45 52 52 4f . (conc "ERRO
4900: 52 3a 20 42 41 44 20 61 70 69 20 63 61 6c 6c 20 R: BAD api call
4910: 22 20 63 6d 64 29 29 29 29 29 29 0a 0a 20 20 20 " cmd))))))..
4920: 20 20 20 20 0a 20 20 20 20 20 20 20 3b 3b 20 73 . ;; s
4930: 61 76 65 20 61 6c 6c 20 73 74 61 74 73 0a 20 20 ave all stats.
4940: 20 20 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 (let ((delt
4950: 61 2d 74 20 28 2d 20 28 63 75 72 72 65 6e 74 2d a-t (- (current-
4960: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 0a 09 09 milliseconds)...
4970: 09 20 73 74 61 72 74 2d 74 29 29 29 0a 09 20 28 . start-t))).. (
4980: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
4990: 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d *db-api-call-tim
49a0: 65 2a 20 63 6d 64 0a 09 09 09 20 20 28 63 6f 6e e* cmd.... (con
49b0: 73 20 64 65 6c 74 61 2d 74 20 28 68 61 73 68 2d s delta-t (hash-
49c0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
49d0: 74 20 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 t *db-api-call-t
49e0: 69 6d 65 2a 20 63 6d 64 20 27 28 29 29 29 29 29 ime* cmd '()))))
49f0: 0a 20 20 20 20 20 20 20 28 69 66 20 77 72 69 74 . (if writ
4a00: 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 ecmd-in-readonly
4a10: 2d 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 -mode.
4a20: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
4a30: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c (common:tel
4a40: 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 emetry-log (conc
4a50: 20 22 61 70 69 2d 6f 75 74 3a 22 28 2d 3e 73 74 "api-out:"(->st
4a60: 72 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 ring cmd)).
4a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
4a90: 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 6d 73 yload: `((params
4aa0: 20 2e 20 2c 70 61 72 61 6d 73 29 0a 20 20 20 20 . ,params).
4ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ad0: 20 20 20 20 20 20 20 20 20 20 28 6f 6b 2d 72 65 (ok-re
4ae0: 73 20 2e 20 23 74 29 29 29 0a 09 20 20 20 20 20 s . #t)))..
4af0: 28 76 65 63 74 6f 72 20 23 66 20 72 65 73 29 29 (vector #f res))
4b00: 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 . (beg
4b10: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
4b20: 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 (common:telemetr
4b30: 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 69 y-log (conc "api
4b40: 2d 6f 75 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 -out:"(->string
4b50: 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 cmd)).
4b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b70: 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f 61 64 payload
4b80: 3a 20 60 28 28 70 61 72 61 6d 73 20 2e 20 2c 70 : `((params . ,p
4b90: 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20 arams).
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 20 20 20 20 20 20
4bc0: 20 20 20 20 20 28 6f 6b 2d 72 65 73 20 2e 20 23 (ok-res . #
4bd0: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
4be0: 20 20 28 76 65 63 74 6f 72 20 23 74 20 72 65 73 (vector #t res
4bf0: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 68 74 74 ))))))))..;; htt
4c00: 70 2d 73 65 72 76 65 72 20 20 73 65 6e 64 2d 72 p-server send-r
4c10: 65 73 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 20 20 esponse.;;
4c20: 20 20 20 20 20 20 20 20 20 20 20 61 70 69 3a 70 api:p
4c30: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 0a 3b rocess-request.;
4c40: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
4c50: 20 20 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b 3b 20 db:*.;;.;;
4c60: 4e 42 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 68 65 NB// Runs on the
4c70: 20 73 65 72 76 65 72 20 61 73 20 70 61 72 74 20 server as part
4c80: 6f 66 20 74 68 65 20 73 65 72 76 65 72 20 6c 6f of the server lo
4c90: 6f 70 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 op.;;.(define (a
4ca0: 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi:process-reque
4cb0: 73 74 20 64 62 73 74 72 75 63 74 20 24 29 20 3b st dbstruct $) ;
4cc0: 3b 20 74 68 65 20 24 20 69 73 20 74 68 65 20 72 ; the $ is the r
4cd0: 65 71 75 65 73 74 20 76 61 72 73 20 70 72 6f 63 equest vars proc
4ce0: 0a 20 20 28 73 65 74 21 20 2a 61 70 69 2d 70 72 . (set! *api-pr
4cf0: 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f ocess-request-co
4d00: 75 6e 74 2a 20 28 2b 20 2a 61 70 69 2d 70 72 6f unt* (+ *api-pro
4d10: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
4d20: 6e 74 2a 20 31 29 29 0a 20 20 28 6c 65 74 2a 20 nt* 1)). (let*
4d30: 28 28 63 6d 64 20 20 20 20 20 28 24 20 27 63 6d ((cmd ($ 'cm
4d40: 64 29 29 0a 09 20 28 70 61 72 61 6d 73 6a 20 28 d)).. (paramsj (
4d50: 24 20 27 70 61 72 61 6d 73 29 29 0a 09 20 28 70 $ 'params)).. (p
4d60: 61 72 61 6d 73 20 20 28 64 62 3a 73 74 72 69 6e arams (db:strin
4d70: 67 2d 3e 6f 62 6a 20 70 61 72 61 6d 73 6a 20 74 g->obj paramsj t
4d80: 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 ransport: 'http)
4d90: 29 20 3b 3b 20 69 6e 63 6f 6d 69 6e 67 20 64 61 ) ;; incoming da
4da0: 74 61 20 66 72 6f 6d 20 74 68 65 20 50 4f 53 54 ta from the POST
4db0: 20 28 6f 72 20 69 73 20 69 74 20 61 20 47 45 54 (or is it a GET
4dc0: 3f 29 0a 09 20 28 72 65 73 64 61 74 20 20 28 61 ?).. (resdat (a
4dd0: 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 pi:execute-reque
4de0: 73 74 73 20 64 62 73 74 72 75 63 74 20 28 76 65 sts dbstruct (ve
4df0: 63 74 6f 72 20 63 6d 64 20 70 61 72 61 6d 73 29 ctor cmd params)
4e00: 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 )) ;; process th
4e10: 65 20 72 65 71 75 65 73 74 2c 20 72 65 73 64 61 e request, resda
4e20: 74 20 3d 20 23 28 20 66 6c 61 67 20 72 65 73 75 t = #( flag resu
4e30: 6c 74 20 29 0a 09 20 28 73 75 63 63 65 73 73 20 lt ).. (success
4e40: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 (vector-ref resd
4e50: 61 74 20 30 29 29 0a 09 20 28 72 65 73 20 20 20 at 0)).. (res
4e60: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 (vector-ref re
4e70: 73 64 61 74 20 31 29 29 29 20 3b 3b 20 28 76 65 sdat 1))) ;; (ve
4e80: 63 74 6f 72 20 66 6c 61 67 20 70 61 79 6c 6f 61 ctor flag payloa
4e90: 64 29 2c 20 67 65 74 20 74 68 65 20 70 61 79 6c d), get the payl
4ea0: 6f 61 64 2c 20 69 67 6e 6f 72 65 20 74 68 65 20 oad, ignore the
4eb0: 66 6c 61 67 20 28 77 68 79 3f 29 0a 20 20 20 20 flag (why?).
4ec0: 28 69 66 20 28 6e 6f 74 20 73 75 63 63 65 73 73 (if (not success
4ed0: 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 )..(debug:print
4ee0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4ef0: 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 73 75 63 ort* "ERROR: suc
4f00: 63 65 73 73 20 66 6c 61 67 20 69 73 20 23 66 20 cess flag is #f
4f10: 66 6f 72 20 22 20 63 6d 64 20 22 20 77 69 74 68 for " cmd " with
4f20: 20 70 61 72 61 6d 73 20 22 20 70 61 72 61 6d 73 params " params
4f30: 29 29 0a 20 20 20 20 28 69 66 20 28 3e 20 2a 61 )). (if (> *a
4f40: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi-process-reque
4f50: 73 74 2d 63 6f 75 6e 74 2a 20 2a 6d 61 78 2d 61 st-count* *max-a
4f60: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi-process-reque
4f70: 73 74 73 2a 29 0a 09 28 73 65 74 21 20 2a 6d 61 sts*)..(set! *ma
4f80: 78 2d 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 x-api-process-re
4f90: 71 75 65 73 74 73 2a 20 2a 61 70 69 2d 70 72 6f quests* *api-pro
4fa0: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
4fb0: 6e 74 2a 29 29 0a 20 20 20 20 28 73 65 74 21 20 nt*)). (set!
4fc0: 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 *api-process-req
4fd0: 75 65 73 74 2d 63 6f 75 6e 74 2a 20 28 2d 20 2a uest-count* (- *
4fe0: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
4ff0: 65 73 74 2d 63 6f 75 6e 74 2a 20 31 29 29 0a 20 est-count* 1)).
5000: 20 20 20 3b 3b 20 54 68 69 73 20 63 61 6e 20 62 ;; This can b
5010: 65 20 68 65 72 65 20 62 75 74 20 6e 65 65 64 73 e here but needs
5020: 20 63 6f 6e 74 72 6f 6c 73 20 74 6f 20 65 6e 73 controls to ens
5030: 75 72 65 20 69 74 20 64 6f 65 73 6e 27 74 20 72 ure it doesn't r
5040: 75 6e 20 6d 6f 72 65 20 74 68 61 6e 20 65 76 65 un more than eve
5050: 72 79 20 34 20 73 65 63 6f 6e 64 73 0a 20 20 20 ry 4 seconds.
5060: 20 3b 3b 20 28 72 6d 74 3a 64 61 74 2d 3e 6a 73 ;; (rmt:dat->js
5070: 6f 6e 2d 73 74 72 0a 20 20 20 20 3b 3b 20 20 28 on-str. ;; (
5080: 69 66 20 28 6f 72 20 28 73 74 72 69 6e 67 3f 20 if (or (string?
5090: 72 65 73 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 res). ;;
50a0: 20 20 20 20 20 28 6c 69 73 74 3f 20 20 20 72 65 (list? re
50b0: 73 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 s). ;;
50c0: 20 20 20 28 6e 75 6d 62 65 72 3f 20 72 65 73 29 (number? res)
50d0: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 . ;;
50e0: 20 28 62 6f 6f 6c 65 61 6e 3f 20 72 65 73 29 29 (boolean? res))
50f0: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 72 65 73 . ;; res
5100: 20 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 28 6c . ;; (l
5110: 69 73 74 20 22 45 52 52 4f 52 2c 20 6e 6f 74 20 ist "ERROR, not
5120: 73 74 72 69 6e 67 2c 20 6c 69 73 74 2c 20 6e 75 string, list, nu
5130: 6d 62 65 72 20 6f 72 20 62 6f 6f 6c 65 61 6e 22 mber or boolean"
5140: 20 31 20 63 6d 64 20 70 61 72 61 6d 73 20 72 65 1 cmd params re
5150: 73 29 29 29 29 29 0a 20 20 20 20 28 64 62 3a 6f s))))). (db:o
5160: 62 6a 2d 3e 73 74 72 69 6e 67 20 72 65 73 20 74 bj->string res t
5170: 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 ransport: 'http)
5180: 29 29 0a 0a ))..