Artifact
e21b71bae70ef969b4898cd3ca4dc2e2dd5cb7cd:
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 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use
01e0: 20 73 72 66 69 2d 36 39 20 70 6f 73 69 78 29 0a srfi-69 posix).
01f0: 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 .(declare (unit
0200: 61 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 28 api)).(declare (
0210: 75 73 65 73 20 72 6d 74 29 29 0a 28 64 65 63 6c uses rmt)).(decl
0220: 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 are (uses db)).(
0230: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 61 declare (uses ta
0240: 73 6b 73 29 29 0a 0a 3b 3b 20 61 6c 6c 6f 77 20 sks))..;; allow
0250: 74 68 65 73 65 20 71 75 65 72 69 65 73 20 74 68 these queries th
0260: 72 6f 75 67 68 20 77 69 74 68 6f 75 74 20 73 74 rough without st
0270: 61 72 74 69 6e 67 20 61 20 73 65 72 76 65 72 0a arting a server.
0280: 3b 3b 0a 28 64 65 66 69 6e 65 20 61 70 69 3a 72 ;;.(define api:r
0290: 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 73 ead-only-queries
02a0: 0a 20 20 27 28 67 65 74 2d 6b 65 79 2d 76 61 6c . '(get-key-val
02b0: 2d 70 61 69 72 73 0a 20 20 20 20 67 65 74 2d 76 -pairs. get-v
02c0: 61 72 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 0a ar. get-keys.
02d0: 20 20 20 20 67 65 74 2d 6b 65 79 2d 76 61 6c 73 get-key-vals
02e0: 0a 20 20 20 20 74 65 73 74 2d 74 6f 70 6c 65 76 . test-toplev
02f0: 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 0a 20 20 20 el-num-items.
0300: 20 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 get-test-info-b
0310: 79 2d 69 64 0a 20 20 20 20 74 65 73 74 2d 67 65 y-id. test-ge
0320: 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 t-rundir-from-te
0330: 73 74 2d 69 64 0a 20 20 20 20 67 65 74 2d 63 6f st-id. get-co
0340: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
0350: 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 0a 20 g-for-testname.
0360: 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 get-count-tes
0370: 74 73 2d 72 75 6e 6e 69 6e 67 0a 20 20 20 20 67 ts-running. g
0380: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
0390: 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f unning-in-jobgro
03a0: 75 70 0a 20 20 20 20 67 65 74 2d 70 72 65 76 69 up. get-previ
03b0: 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 ous-test-run-rec
03c0: 6f 72 64 0a 20 20 20 20 67 65 74 2d 6d 61 74 63 ord. get-matc
03d0: 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 hing-previous-te
03e0: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 0a 20 st-run-records.
03f0: 20 20 20 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 test-get-logf
0400: 69 6c 65 2d 69 6e 66 6f 0a 20 20 20 20 74 65 73 ile-info. tes
0410: 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f t-get-records-fo
0420: 72 2d 69 6e 64 65 78 2d 66 69 6c 65 0a 20 20 20 r-index-file.
0430: 20 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 get-testinfo-st
0440: 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 20 74 ate-status. t
0450: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
0460: 65 73 73 2d 70 69 64 0a 20 20 20 20 74 65 73 74 ess-pid. test
0470: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
0480: 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 ing-keynames-tar
0490: 67 65 74 2d 6e 65 77 0a 20 20 20 20 67 65 74 2d get-new. get-
04a0: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 0a prereqs-not-met.
04b0: 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 65 get-count-te
04c0: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
04d0: 72 75 6e 2d 69 64 0a 20 20 20 20 67 65 74 2d 72 run-id. get-r
04e0: 75 6e 2d 69 6e 66 6f 0a 20 20 20 20 67 65 74 2d un-info. get-
04f0: 72 75 6e 2d 73 74 61 74 75 73 0a 20 20 20 20 67 run-status. g
0500: 65 74 2d 72 75 6e 2d 73 74 61 74 73 0a 20 20 20 et-run-stats.
0510: 20 67 65 74 2d 74 61 72 67 65 74 73 0a 20 20 20 get-targets.
0520: 20 67 65 74 2d 74 61 72 67 65 74 0a 20 20 20 20 get-target.
0530: 3b 3b 20 72 65 67 69 73 74 65 72 2d 72 75 6e 0a ;; register-run.
0540: 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d 74 61 get-tests-ta
0550: 67 73 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 gs. get-tests
0560: 2d 66 6f 72 2d 72 75 6e 0a 20 20 20 20 67 65 74 -for-run. get
0570: 2d 74 65 73 74 2d 69 64 0a 20 20 20 20 67 65 74 -test-id. get
0580: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d -tests-for-runs-
0590: 6d 69 6e 64 61 74 61 0a 20 20 20 20 67 65 74 2d mindata. get-
05a0: 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 run-name-from-id
05b0: 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 0a 20 20 . get-runs.
05c0: 20 20 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 0a 20 get-num-runs.
05d0: 20 20 20 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 get-all-run-i
05e0: 64 73 0a 20 20 20 20 67 65 74 2d 70 72 65 76 2d ds. get-prev-
05f0: 72 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 74 2d run-ids. get-
0600: 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 run-ids-matching
0610: 2d 74 61 72 67 65 74 0a 20 20 20 20 67 65 74 2d -target. get-
0620: 72 75 6e 73 2d 62 79 2d 70 61 74 74 0a 20 20 20 runs-by-patt.
0630: 20 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 0a get-steps-data.
0640: 20 20 20 20 67 65 74 2d 73 74 65 70 73 2d 66 6f get-steps-fo
0650: 72 2d 74 65 73 74 0a 20 20 20 20 72 65 61 64 2d r-test. read-
0660: 74 65 73 74 2d 64 61 74 61 0a 20 20 20 20 6c 6f test-data. lo
0670: 67 69 6e 0a 20 20 20 20 74 61 73 6b 73 2d 67 65 gin. tasks-ge
0680: 74 2d 6c 61 73 74 0a 20 20 20 20 74 65 73 74 6d t-last. testm
0690: 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 0a 20 eta-get-record.
06a0: 20 20 20 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 have-incomple
06b0: 74 65 73 3f 0a 20 20 20 20 73 79 6e 63 68 61 73 tes?. synchas
06c0: 68 2d 67 65 74 0a 20 20 20 20 29 29 0a 0a 28 64 h-get. ))..(d
06d0: 65 66 69 6e 65 20 61 70 69 3a 77 72 69 74 65 2d efine api:write-
06e0: 71 75 65 72 69 65 73 0a 20 20 27 28 0a 20 20 20 queries. '(.
06f0: 20 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 20 get-keys-write
0700: 3b 3b 20 64 75 6d 6d 79 20 22 77 72 69 74 65 22 ;; dummy "write"
0710: 20 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 20 query to force
0720: 73 65 72 76 65 72 20 73 74 61 72 74 0a 0a 20 20 server start..
0730: 20 20 3b 3b 20 53 45 52 56 45 52 53 0a 20 20 20 ;; SERVERS.
0740: 20 73 74 61 72 74 2d 73 65 72 76 65 72 0a 20 20 start-server.
0750: 20 20 6b 69 6c 6c 2d 73 65 72 76 65 72 0a 0a 20 kill-server..
0760: 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 20 ;; TESTS.
0770: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
0780: 74 61 74 75 73 2d 62 79 2d 69 64 0a 20 20 20 20 tatus-by-id.
0790: 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f delete-test-reco
07a0: 72 64 73 0a 20 20 20 20 64 65 6c 65 74 65 2d 6f rds. delete-o
07b0: 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d ld-deleted-test-
07c0: 72 65 63 6f 72 64 73 0a 20 20 20 20 74 65 73 74 records. test
07d0: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
07e0: 73 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 74 s. test-set-t
07f0: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 0a 20 op-process-pid.
0800: 20 20 20 73 65 74 2d 73 74 61 74 65 2d 73 74 61 set-state-sta
0810: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
0820: 69 74 65 6d 73 0a 20 20 20 20 75 70 64 61 74 65 items. update
0830: 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 -pass-fail-count
0840: 73 0a 20 20 20 20 74 6f 70 2d 74 65 73 74 2d 73 s. top-test-s
0850: 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 et-per-pf-counts
0860: 20 3b 3b 20 28 64 62 3a 74 6f 70 2d 74 65 73 74 ;; (db:top-test
0870: 2d 73 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e -set-per-pf-coun
0880: 74 73 20 28 64 62 3a 67 65 74 2d 64 62 20 2a 64 ts (db:get-db *d
0890: 62 2a 20 35 29 20 35 20 22 72 75 6e 66 69 72 73 b* 5) 5 "runfirs
08a0: 74 22 29 0a 0a 20 20 20 20 3b 3b 20 52 55 4e 53 t").. ;; RUNS
08b0: 0a 20 20 20 20 72 65 67 69 73 74 65 72 2d 72 75 . register-ru
08c0: 6e 0a 20 20 20 20 73 65 74 2d 74 65 73 74 73 2d n. set-tests-
08d0: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 state-status.
08e0: 20 64 65 6c 65 74 65 2d 72 75 6e 0a 20 20 20 20 delete-run.
08f0: 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 0a lock/unlock-run.
0900: 20 20 20 20 75 70 64 61 74 65 2d 72 75 6e 2d 65 update-run-e
0910: 76 65 6e 74 5f 74 69 6d 65 0a 20 20 20 20 6d 61 vent_time. ma
0920: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 0a 0a 20 rk-incomplete..
0930: 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 ;; STEPS.
0940: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
0950: 74 75 73 21 0a 0a 20 20 20 20 3b 3b 20 54 45 53 tus!.. ;; TES
0960: 54 20 44 41 54 41 0a 20 20 20 20 74 65 73 74 2d T DATA. test-
0970: 64 61 74 61 2d 72 6f 6c 6c 75 70 0a 20 20 20 20 data-rollup.
0980: 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 0a 0a csv->test-data..
0990: 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20 20 ;; MISC.
09a0: 73 79 6e 63 2d 69 6e 6d 65 6d 2d 3e 64 62 0a 0a sync-inmem->db..
09b0: 20 20 20 20 3b 3b 20 54 45 53 54 4d 45 54 41 0a ;; TESTMETA.
09c0: 20 20 20 20 74 65 73 74 6d 65 74 61 2d 61 64 64 testmeta-add
09d0: 2d 72 65 63 6f 72 64 0a 20 20 20 20 74 65 73 74 -record. test
09e0: 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c meta-update-fiel
09f0: 64 0a 0a 20 20 20 20 3b 3b 20 54 41 53 4b 53 0a d.. ;; TASKS.
0a00: 20 20 20 20 74 61 73 6b 73 2d 61 64 64 0a 20 20 tasks-add.
0a10: 20 20 74 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 tasks-set-stat
0a20: 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 e-given-param-ke
0a30: 79 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 54 68 65 y. ))..;; The
0a40: 73 65 20 61 72 65 20 63 61 6c 6c 65 64 20 62 79 se are called by
0a50: 20 74 68 65 20 73 65 72 76 65 72 20 6f 6e 20 72 the server on r
0a60: 65 63 69 70 74 20 6f 66 20 2f 61 70 69 20 63 61 ecipt of /api ca
0a70: 6c 6c 73 0a 3b 3b 20 20 20 20 2d 20 6b 65 65 70 lls.;; - keep
0a80: 20 69 74 20 73 69 6d 70 6c 65 2c 20 6f 6e 6c 79 it simple, only
0a90: 20 72 65 74 75 72 6e 20 74 68 65 20 61 63 74 75 return the actu
0aa0: 61 6c 20 72 65 73 75 6c 74 20 6f 66 20 74 68 65 al result of the
0ab0: 20 63 61 6c 6c 2c 20 69 2e 65 2e 20 6e 6f 20 6d call, i.e. no m
0ac0: 65 74 61 20 69 6e 66 6f 20 68 65 72 65 0a 3b 3b eta info here.;;
0ad0: 0a 3b 3b 20 20 20 20 2d 20 72 65 74 75 72 6e 73 .;; - returns
0ae0: 20 23 28 20 66 6c 61 67 20 72 65 73 75 6c 74 20 #( flag result
0af0: 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 70 ).;;.(define (ap
0b00: 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 73 i:execute-reques
0b10: 74 73 20 64 62 73 74 72 75 63 74 20 64 61 74 29 ts dbstruct dat)
0b20: 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
0b30: 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 tions. exn.
0b40: 28 6c 65 74 20 28 28 63 61 6c 6c 2d 63 68 61 69 (let ((call-chai
0b50: 6e 20 28 67 65 74 2d 63 61 6c 6c 2d 63 68 61 69 n (get-call-chai
0b60: 6e 29 29 0a 20 20 20 20 20 20 20 20 20 29 0a 20 n)). ).
0b70: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0b80: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
0b90: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
0ba0: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
0bb0: 65 73 74 73 20 72 65 63 65 69 76 65 64 20 61 6e ests received an
0bc0: 20 65 78 63 65 70 74 69 6f 6e 20 66 72 6f 6d 20 exception from
0bd0: 70 65 65 72 22 29 0a 20 20 20 20 20 28 70 72 69 peer"). (pri
0be0: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 nt-call-chain (c
0bf0: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
0c00: 74 29 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a t)). (debug:
0c10: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
0c20: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
0c30: 73 61 67 65 3a 20 22 20 20 28 28 63 6f 6e 64 69 sage: " ((condi
0c40: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
0c50: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
0c60: 73 61 67 65 29 20 65 78 6e 29 29 20 20 20 20 20 sage) exn))
0c70: 20 20 0a 20 20 20 20 20 28 76 65 63 74 6f 72 20 . (vector
0c80: 23 66 20 28 76 65 63 74 6f 72 20 65 78 6e 20 63 #f (vector exn c
0c90: 61 6c 6c 2d 63 68 61 69 6e 20 64 61 74 29 29 29 all-chain dat)))
0ca0: 20 3b 3b 20 72 65 74 75 72 6e 20 73 6f 6d 65 20 ;; return some
0cb0: 73 74 75 66 66 20 66 6f 72 20 64 65 62 75 67 20 stuff for debug
0cc0: 69 66 20 61 6e 20 65 78 63 65 70 74 69 6f 6e 20 if an exception
0cd0: 68 61 70 70 65 6e 73 0a 20 20 20 28 63 6f 6e 64 happens. (cond
0ce0: 0a 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 74 . ((not (vect
0cf0: 6f 72 3f 20 64 61 74 29 29 20 20 20 20 20 20 20 or? dat))
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
0d10: 69 74 20 69 73 20 61 6e 20 65 72 72 6f 72 20 74 it is an error t
0d20: 6f 20 6e 6f 74 20 72 65 63 65 69 76 65 20 61 20 o not receive a
0d30: 76 65 63 74 6f 72 0a 20 20 20 20 20 28 76 65 63 vector. (vec
0d40: 74 6f 72 20 23 66 20 23 66 20 22 72 65 6d 6f 74 tor #f #f "remot
0d50: 65 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 e must be called
0d60: 20 77 69 74 68 20 61 20 76 65 63 74 6f 72 22 29 with a vector")
0d70: 20 20 20 20 20 20 20 29 0a 20 20 20 20 28 65 6c ). (el
0d80: 73 65 20 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 se . (let*
0d90: 28 28 63 6d 64 2d 69 6e 20 28 76 65 63 74 6f 72 ((cmd-in (vector
0da0: 2d 72 65 66 20 64 61 74 20 30 29 29 0a 20 20 20 -ref dat 0)).
0db0: 20 20 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 (cmd
0dc0: 20 28 69 66 20 28 73 79 6d 62 6f 6c 3f 20 63 6d (if (symbol? cm
0dd0: 64 2d 69 6e 29 0a 20 20 20 20 20 20 20 20 20 20 d-in).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6d cm
0df0: 64 2d 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 d-in.
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
0e10: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
0e20: 2d 69 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 -in))).
0e30: 20 20 20 28 70 61 72 61 6d 73 20 28 76 65 63 74 (params (vect
0e40: 6f 72 2d 72 65 66 20 64 61 74 20 31 29 29 0a 20 or-ref dat 1)).
0e50: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 72 (star
0e60: 74 2d 74 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c t-t (current-mil
0e70: 6c 69 73 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 liseconds)).
0e80: 20 20 20 20 20 20 20 20 28 72 65 61 64 6f 6e 6c (readonl
0e90: 79 2d 6d 6f 64 65 20 28 64 62 72 3a 64 62 73 74 y-mode (dbr:dbst
0ea0: 72 75 63 74 2d 72 65 61 64 2d 6f 6e 6c 79 20 64 ruct-read-only d
0eb0: 62 73 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 bstruct)).
0ec0: 20 20 20 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d (readonly-
0ed0: 63 6f 6d 6d 61 6e 64 20 28 6d 65 6d 62 65 72 20 command (member
0ee0: 63 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c cmd api:read-onl
0ef0: 79 2d 71 75 65 72 69 65 73 29 29 0a 20 20 20 20 y-queries)).
0f00: 20 20 20 20 20 20 20 20 28 77 72 69 74 65 63 6d (writecm
0f10: 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f d-in-readonly-mo
0f20: 64 65 20 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 de (and readonly
0f30: 2d 6d 6f 64 65 20 28 6e 6f 74 20 72 65 61 64 6f -mode (not reado
0f40: 6e 6c 79 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 20 nly-command))).
0f50: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73 20 (res
0f60: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
0f70: 20 28 69 66 20 77 72 69 74 65 63 6d 64 2d 69 6e (if writecmd-in
0f80: 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 -readonly-mode.
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fa0: 28 63 6f 6e 63 20 22 61 74 74 65 6d 70 74 20 74 (conc "attempt t
0fb0: 6f 20 72 75 6e 20 77 72 69 74 65 20 63 6f 6d 6d o run write comm
0fc0: 61 6e 64 20 22 63 6d 64 22 20 6f 6e 20 61 20 72 and "cmd" on a r
0fd0: 65 61 64 2d 6f 6e 6c 79 20 64 61 74 61 62 61 73 ead-only databas
0fe0: 65 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e").
0ff0: 20 20 20 20 20 28 63 61 73 65 20 63 6d 64 0a 20 (case cmd.
1000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1010: 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============
1020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1040: 3d 3d 3d 0a 20 20 20 20 20 20 20 20 20 20 20 20 ===.
1050: 20 20 20 20 20 20 20 3b 3b 20 52 45 41 44 2f 57 ;; READ/W
1060: 52 49 54 45 20 51 55 45 52 49 45 53 0a 20 20 20 RITE QUERIES.
1070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1080: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b0: 3d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 =..
10c0: 20 20 20 20 20 20 28 28 67 65 74 2d 6b 65 79 73 ((get-keys
10d0: 2d 77 72 69 74 65 29 20 20 20 20 20 20 20 20 20 -write)
10e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
10f0: 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 73 74 db:get-keys dbst
1100: 72 75 63 74 29 29 20 3b 3b 20 66 6f 72 63 65 20 ruct)) ;; force
1110: 61 20 64 75 6d 6d 79 20 22 77 72 69 74 65 22 20 a dummy "write"
1120: 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 20 73 query to force s
1130: 65 72 76 65 72 3b 20 66 6f 72 20 64 65 62 75 67 erver; for debug
1140: 20 69 6e 20 2d 72 65 70 6c 0a 20 20 20 20 20 20 in -repl.
1150: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 .
1160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1170: 20 3b 3b 20 53 45 52 56 45 52 53 0a 20 20 20 20 ;; SERVERS.
1180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1190: 28 73 74 61 72 74 2d 73 65 72 76 65 72 29 20 20 (start-server)
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b0: 20 20 28 61 70 70 6c 79 20 73 65 72 76 65 72 3a (apply server:
11c0: 6b 69 6e 64 2d 72 75 6e 20 70 61 72 61 6d 73 29 kind-run params)
11d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
11e0: 20 20 20 20 20 28 28 6b 69 6c 6c 2d 73 65 72 76 ((kill-serv
11f0: 65 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 er)
1200: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 73 (set! *s
1210: 65 72 76 65 72 2d 72 75 6e 2a 20 23 66 29 29 0a erver-run* #f)).
1220: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1230: 20 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 ;; TESTS.
1240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1250: 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 ((test-set-state
1260: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 29 20 20 -status-by-id)
1270: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
1280: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
1290: 75 73 2d 62 79 2d 69 64 20 64 62 73 74 72 75 63 us-by-id dbstruc
12a0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
12b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
12c0: 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f delete-test-reco
12d0: 72 64 73 29 20 20 20 20 20 20 20 20 20 20 20 20 rds)
12e0: 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 (apply db:delet
12f0: 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 64 e-test-records d
1300: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
1310: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1320: 20 20 20 20 28 28 64 65 6c 65 74 65 2d 6f 6c 64 ((delete-old
1330: 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 -deleted-test-re
1340: 63 6f 72 64 73 29 20 28 61 70 70 6c 79 20 64 62 cords) (apply db
1350: 3a 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 :delete-old-dele
1360: 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ted-test-records
1370: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
1380: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1390: 20 20 20 20 20 20 28 28 74 65 73 74 2d 73 65 74 ((test-set
13a0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 -state-status)
13b0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
13c0: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
13d0: 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 e-status dbstruc
13e0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1400: 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f test-set-top-pro
1410: 63 65 73 73 2d 70 69 64 29 20 20 20 20 20 20 20 cess-pid)
1420: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
1430: 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d set-top-process-
1440: 70 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 pid dbstruct par
1450: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
1460: 20 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 73 ((set-s
1470: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
1480: 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 29 20 28 roll-up-items) (
1490: 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 73 74 61 apply db:set-sta
14a0: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
14b0: 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 64 62 73 74 ll-up-items dbst
14c0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 20 28 28 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d ((top-test-set-
14f0: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 29 20 20 per-pf-counts)
1500: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 6f (apply db:to
1510: 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 p-test-set-per-p
1520: 66 2d 63 6f 75 6e 74 73 20 64 62 73 74 72 75 63 f-counts dbstruc
1530: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1550: 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 test-set-archive
1560: 2d 62 6c 6f 63 6b 2d 69 64 29 20 20 20 20 20 20 -block-id)
1570: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
1580: 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 set-archive-bloc
1590: 6b 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 k-id dbstruct pa
15a0: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
15b0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 55 ;; RU
15c0: 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 NS.
15d0: 20 20 20 20 20 20 28 28 72 65 67 69 73 74 65 72 ((register
15e0: 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 -run)
15f0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1600: 72 65 67 69 73 74 65 72 2d 72 75 6e 20 64 62 73 register-run dbs
1610: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
1620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1630: 20 20 28 28 73 65 74 2d 74 65 73 74 73 2d 73 74 ((set-tests-st
1640: 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 ate-status)
1650: 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d (apply db:set-
1660: 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 tests-state-stat
1670: 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 us dbstruct para
1680: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
1690: 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74 65 ((delete
16a0: 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 -run)
16b0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
16c0: 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 73 b:delete-run dbs
16d0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
16e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16f0: 20 20 28 28 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d ((lock/unlock-
1700: 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 run)
1710: 20 20 28 61 70 70 6c 79 20 64 62 3a 6c 6f 63 6b (apply db:lock
1720: 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 64 62 73 74 /unlock-run dbst
1730: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1750: 20 28 28 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 ((update-run-ev
1760: 65 6e 74 5f 74 69 6d 65 29 20 20 20 20 20 20 20 ent_time)
1770: 20 28 61 70 70 6c 79 20 64 62 3a 75 70 64 61 74 (apply db:updat
1780: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
1790: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
17a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17b0: 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d 72 ((update-r
17c0: 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 un-stats)
17d0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
17e0: 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 update-run-stats
17f0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
1800: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1810: 20 20 20 20 20 20 28 28 73 65 74 2d 76 61 72 29 ((set-var)
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1830: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1840: 73 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 set-var dbstruct
1850: 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 params))..
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1870: 20 53 54 45 50 53 0a 20 20 20 20 20 20 20 20 20 STEPS.
1880: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
1890: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
18a0: 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 ) (apply
18b0: 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 db:teststep-set
18c0: 2d 73 74 61 74 75 73 21 20 64 62 73 74 72 75 63 -status! dbstruc
18d0: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
18e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
18f0: 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 20 ; TEST DATA.
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1910: 28 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 (test-data-rollu
1920: 70 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 p) (
1930: 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 64 61 apply db:test-da
1940: 74 61 2d 72 6f 6c 6c 75 70 20 64 62 73 74 72 75 ta-rollup dbstru
1950: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1970: 28 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 29 (csv->test-data)
1980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1990: 61 70 70 6c 79 20 64 62 3a 63 73 76 2d 3e 74 65 apply db:csv->te
19a0: 73 74 2d 64 61 74 61 20 64 62 73 74 72 75 63 74 st-data dbstruct
19b0: 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 params))..
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
19d0: 20 4d 49 53 43 0a 20 20 20 20 20 20 20 20 20 20 MISC.
19e0: 20 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 2d ((sync-
19f0: 69 6e 6d 65 6d 2d 3e 64 62 29 20 20 20 20 20 20 inmem->db)
1a00: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
1a10: 72 75 6e 2d 69 64 20 28 63 61 72 20 70 61 72 61 run-id (car para
1a20: 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ms))).
1a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a50: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 (db:s
1a60: 79 6e 63 2d 74 6f 75 63 68 65 64 20 64 62 73 74 ync-touched dbst
1a70: 72 75 63 74 20 72 75 6e 2d 69 64 20 66 6f 72 63 ruct run-id forc
1a80: 65 2d 73 79 6e 63 3a 20 23 74 29 29 29 0a 20 20 e-sync: #t))).
1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aa0: 20 28 28 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 ((mark-incomple
1ab0: 74 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 te)
1ac0: 20 28 61 70 70 6c 79 20 64 62 3a 66 69 6e 64 2d (apply db:find-
1ad0: 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
1ae0: 65 74 65 20 64 62 73 74 72 75 63 74 20 70 61 72 ete dbstruct par
1af0: 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 ams))..
1b00: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 53 ;; TES
1b10: 54 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 20 TMETA.
1b20: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 6d ((testm
1b30: 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 29 20 eta-add-record)
1b40: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1b50: 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 testmeta-add-rec
1b60: 6f 72 64 20 64 62 73 74 72 75 63 74 20 70 61 72 ord dbstruct par
1b70: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
1b80: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 6d ((testm
1b90: 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 eta-update-field
1ba0: 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a ) (apply db:
1bb0: 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d testmeta-update-
1bc0: 66 69 65 6c 64 20 64 62 73 74 72 75 63 74 20 70 field dbstruct p
1bd0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
1be0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
1bf0: 2d 74 65 73 74 73 2d 74 61 67 73 29 20 20 20 20 -tests-tags)
1c00: 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d (db:get-
1c10: 74 65 73 74 73 2d 74 61 67 73 20 64 62 73 74 72 tests-tags dbstr
1c20: 75 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 20 uct))..
1c30: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 53 ;; TAS
1c40: 4b 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 KS.
1c50: 20 20 20 20 20 20 28 28 74 61 73 6b 73 2d 61 64 ((tasks-ad
1c60: 64 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d)
1c70: 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 3a (apply tasks:
1c80: 61 64 64 20 64 62 73 74 72 75 63 74 20 70 61 72 add dbstruct par
1c90: 61 6d 73 29 29 20 20 20 0a 20 20 20 20 20 20 20 ams)) .
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 ((ta
1cb0: 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 sks-set-state-gi
1cc0: 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 29 20 28 ven-param-key) (
1cd0: 61 70 70 6c 79 20 74 61 73 6b 73 3a 73 65 74 2d apply tasks:set-
1ce0: 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 state-given-para
1cf0: 6d 2d 6b 65 79 20 64 62 73 74 72 75 63 74 20 70 m-key dbstruct p
1d00: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
1d10: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 73 ((tas
1d20: 6b 73 2d 67 65 74 2d 6c 61 73 74 29 20 20 20 20 ks-get-last)
1d30: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 74 (apply t
1d40: 61 73 6b 73 3a 67 65 74 2d 6c 61 73 74 20 64 62 asks:get-last db
1d50: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
1d60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d70: 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 0a ;; ARCHIVES.
1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d90: 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d ;; ((archive-
1da0: 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 29 get-allocations)
1db0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
1dc0: 20 20 20 20 20 20 20 28 28 61 72 63 68 69 76 65 ((archive
1dd0: 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 29 20 -register-disk)
1de0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 61 72 (apply db:ar
1df0: 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 64 chive-register-d
1e00: 69 73 6b 20 64 62 73 74 72 75 63 74 20 70 61 72 isk dbstruct par
1e10: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
1e20: 20 20 20 20 20 20 20 20 20 28 28 61 72 63 68 69 ((archi
1e30: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 ve-register-bloc
1e40: 6b 2d 6e 61 6d 65 29 28 61 70 70 6c 79 20 64 62 k-name)(apply db
1e50: 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 :archive-registe
1e60: 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 64 62 73 r-block-name dbs
1e70: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
1e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e90: 20 20 28 28 61 72 63 68 69 76 65 2d 61 6c 6c 6f ((archive-allo
1ea0: 63 61 74 65 2d 74 65 73 74 73 75 69 74 65 2f 61 cate-testsuite/a
1eb0: 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29 28 61 70 rea-to-block)(ap
1ec0: 70 6c 79 20 64 62 3a 61 72 63 68 69 76 65 2d 61 ply db:archive-a
1ed0: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
1ee0: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 e/area-to-block
1ef0: 64 62 73 74 72 75 63 74 20 62 6c 6f 63 6b 2d 69 dbstruct block-i
1f00: 64 20 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 d testsuite-name
1f10: 20 61 72 65 61 6b 65 79 29 29 0a 0a 20 20 20 20 areakey))..
1f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1f30: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f70: 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20 20 20 20 =======.
1f80: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 45 ;; RE
1f90: 41 44 20 4f 4e 4c 59 20 51 55 45 52 49 45 53 0a AD ONLY QUERIES.
1fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb0: 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;===========
1fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 20 20 ===========..
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2010: 3b 3b 20 4b 45 59 53 0a 20 20 20 20 20 20 20 20 ;; KEYS.
2020: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
2030: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 29 20 -key-val-pairs)
2040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2050: 70 70 6c 79 20 64 62 3a 67 65 74 2d 6b 65 79 2d pply db:get-key-
2060: 76 61 6c 2d 70 61 69 72 73 20 64 62 73 74 72 75 val-pairs dbstru
2070: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2090: 28 67 65 74 2d 6b 65 79 73 29 20 20 20 20 20 20 (get-keys)
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 (db:get-keys d
20c0: 62 73 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 bstruct)).
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
20e0: 65 74 2d 6b 65 79 2d 76 61 6c 73 29 20 20 20 20 et-key-vals)
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2100: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6b 65 (apply db:get-ke
2110: 79 2d 76 61 6c 73 20 64 62 73 74 72 75 63 74 20 y-vals dbstruct
2120: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2130: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
2140: 74 2d 74 61 72 67 65 74 29 20 20 20 20 20 20 20 t-target)
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2160: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 61 72 apply db:get-tar
2170: 67 65 74 20 64 62 73 74 72 75 63 74 20 70 61 72 get dbstruct par
2180: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2190: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 ((get-t
21a0: 61 72 67 65 74 73 29 20 20 20 20 20 20 20 20 20 argets)
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
21c0: 67 65 74 2d 74 61 72 67 65 74 73 20 64 62 73 74 get-targets dbst
21d0: 72 75 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 ruct))..
21e0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 41 52 ;; AR
21f0: 43 48 49 56 45 53 0a 20 20 20 20 20 20 20 20 20 CHIVES.
2200: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
2210: 2d 67 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f -get-archive-blo
2220: 63 6b 2d 69 6e 66 6f 29 20 20 20 20 20 28 61 70 ck-info) (ap
2230: 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d ply db:test-get-
2240: 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e archive-block-in
2250: 66 6f 20 64 62 73 74 72 75 63 74 20 70 61 72 61 fo dbstruct para
2260: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2270: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
2280: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 ;; T
2290: 45 53 54 53 0a 20 20 20 20 20 20 20 20 20 20 20 ESTS.
22a0: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 74 ((test-t
22b0: 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d oplevel-num-item
22c0: 73 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c s) (appl
22d0: 79 20 64 62 3a 74 65 73 74 2d 74 6f 70 6c 65 76 y db:test-toplev
22e0: 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20 64 62 73 el-num-items dbs
22f0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2310: 20 20 28 28 67 65 74 2d 74 65 73 74 2d 69 6e 66 ((get-test-inf
2320: 6f 2d 62 79 2d 69 64 29 09 20 20 20 20 20 20 20 o-by-id).
2330: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 (apply db:get-te
2340: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 st-info-by-id db
2350: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2370: 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 72 75 ((test-get-ru
2380: 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 ndir-from-test-i
2390: 64 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a d) (apply db:
23a0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d test-get-rundir-
23b0: 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 73 from-test-id dbs
23c0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
23d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e0: 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 ((get-count-te
23f0: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
2400: 74 65 73 74 6e 61 6d 65 29 20 28 61 70 70 6c 79 testname) (apply
2410: 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 db:get-count-te
2420: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
2430: 74 65 73 74 6e 61 6d 65 20 64 62 73 74 72 75 63 testname dbstruc
2440: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2460: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
2470: 72 75 6e 6e 69 6e 67 29 20 20 20 20 20 20 20 20 running)
2480: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 (apply db:get-c
2490: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
24a0: 6e 67 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ng dbstruct para
24b0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
24c0: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f ((get-co
24d0: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
24e0: 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 29 20 28 g-in-jobgroup) (
24f0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 apply db:get-cou
2500: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
2510: 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 64 62 73 -in-jobgroup dbs
2520: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2540: 20 20 3b 3b 20 28 28 64 65 6c 65 74 65 2d 74 65 ;; ((delete-te
2550: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 29 st-step-records)
2560: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2570: 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 b:delete-test-st
2580: 65 70 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 ep-records dbstr
2590: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 28 28 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 ((get-previous-t
25c0: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 29 20 est-run-record)
25d0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
25e0: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
25f0: 75 6e 2d 72 65 63 6f 72 64 20 64 62 73 74 72 75 un-record dbstru
2600: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2620: 28 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 (get-matching-pr
2630: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
2640: 72 65 63 6f 72 64 73 29 28 61 70 70 6c 79 20 64 records)(apply d
2650: 62 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 b:get-matching-p
2660: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e revious-test-run
2670: 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 63 -records dbstruc
2680: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
26a0: 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 test-get-logfile
26b0: 2d 69 6e 66 6f 29 20 20 20 20 20 20 20 20 20 20 -info)
26c0: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
26d0: 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f get-logfile-info
26e0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
26f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2700: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 ((test-get
2710: 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 -records-for-ind
2720: 65 78 2d 66 69 6c 65 29 20 20 28 61 70 70 6c 79 ex-file) (apply
2730: 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 65 63 db:test-get-rec
2740: 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 ords-for-index-f
2750: 69 6c 65 20 64 62 73 74 72 75 63 74 20 70 61 72 ile dbstruct par
2760: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2770: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 ((get-t
2780: 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 estinfo-state-st
2790: 61 74 75 73 29 20 20 20 20 20 20 20 28 61 70 70 atus) (app
27a0: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 69 6e ly db:get-testin
27b0: 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 fo-state-status
27c0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
27d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
27e0: 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d ((test-get-
27f0: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 29 top-process-pid)
2800: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2810: 62 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 b:test-get-top-p
2820: 72 6f 63 65 73 73 2d 70 69 64 20 64 62 73 74 72 rocess-pid dbstr
2830: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2850: 28 28 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 ((test-get-paths
2860: 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d -matching-keynam
2870: 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 29 20 28 es-target-new) (
2880: 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 apply db:test-ge
2890: 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
28a0: 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 -keynames-target
28b0: 2d 6e 65 77 20 64 62 73 74 72 75 63 74 20 70 61 -new dbstruct pa
28c0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
28d0: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
28e0: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 prereqs-not-met)
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2900: 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 65 72 65 ply db:get-prere
2910: 71 73 2d 6e 6f 74 2d 6d 65 74 20 64 62 73 74 72 qs-not-met dbstr
2920: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2940: 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 ((get-count-test
2950: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 s-running-for-ru
2960: 6e 2d 69 64 29 20 28 61 70 70 6c 79 20 64 62 3a n-id) (apply db:
2970: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
2980: 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d running-for-run-
2990: 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 id dbstruct para
29a0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
29b0: 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 68 61 ((syncha
29c0: 73 68 2d 67 65 74 29 20 20 20 20 20 20 20 20 20 sh-get)
29d0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
29e0: 79 20 73 79 6e 63 68 61 73 68 3a 73 65 72 76 65 y synchash:serve
29f0: 72 2d 67 65 74 20 64 62 73 74 72 75 63 74 20 70 r-get dbstruct p
2a00: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
2a10: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
2a20: 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 29 20 -raw-run-stats)
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2a40: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 61 77 2d pply db:get-raw-
2a50: 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 run-stats dbstru
2a60: 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 ct params))..
2a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a80: 3b 3b 20 52 55 4e 53 0a 20 20 20 20 20 20 20 20 ;; RUNS.
2a90: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
2aa0: 2d 72 75 6e 2d 69 6e 66 6f 29 20 20 20 20 20 20 -run-info)
2ab0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
2ac0: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 y db:get-run-inf
2ad0: 6f 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d o dbstruct param
2ae0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2af0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e ((get-run
2b00: 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20 20 -status)
2b10: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2b20: 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 :get-run-status
2b30: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2b40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2b50: 20 20 20 20 20 28 28 73 65 74 2d 72 75 6e 2d 73 ((set-run-s
2b60: 74 61 74 75 73 29 20 20 20 20 20 20 20 20 20 20 tatus)
2b70: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 (apply db:s
2b80: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 64 62 et-run-status db
2b90: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bb0: 20 20 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 ((get-tests-f
2bc0: 6f 72 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 or-run)
2bd0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
2be0: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 -tests-for-run d
2bf0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2c00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2c10: 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 2d 69 ((get-test-i
2c20: 64 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d)
2c30: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
2c40: 74 2d 74 65 73 74 2d 69 64 20 64 62 73 74 72 75 t-test-id dbstru
2c50: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2c70: 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 (get-tests-for-r
2c80: 75 6e 2d 6d 69 6e 64 61 74 61 29 20 20 20 20 28 un-mindata) (
2c90: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 apply db:get-tes
2ca0: 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 ts-for-run-minda
2cb0: 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ta dbstruct para
2cc0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2cd0: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 ((get-ru
2ce0: 6e 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ns)
2cf0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2d00: 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 73 74 72 b:get-runs dbstr
2d10: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d30: 28 28 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 29 20 ((get-num-runs)
2d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d50: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6e 75 (apply db:get-nu
2d60: 6d 2d 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 m-runs dbstruct
2d70: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
2d90: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 20 20 t-all-run-ids)
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
2db0: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 get-all-run-ids
2dc0: 64 62 73 74 72 75 63 74 29 29 0a 20 20 20 20 20 dbstruct)).
2dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2de0: 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 get-prev-run-ids
2df0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 ) (a
2e00: 70 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 65 76 pply db:get-prev
2e10: 2d 72 75 6e 2d 69 64 73 20 64 62 73 74 72 75 63 -run-ids dbstruc
2e20: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2e40: 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 get-run-ids-matc
2e50: 68 69 6e 67 2d 74 61 72 67 65 74 29 20 20 28 61 hing-target) (a
2e60: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d pply db:get-run-
2e70: 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 ids-matching-tar
2e80: 67 65 74 20 64 62 73 74 72 75 63 74 20 70 61 72 get dbstruct par
2e90: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2ea0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
2eb0: 75 6e 73 2d 62 79 2d 70 61 74 74 29 20 20 20 20 uns-by-patt)
2ec0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2ed0: 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 db:get-runs-by-p
2ee0: 61 74 74 20 64 62 73 74 72 75 63 74 20 70 61 72 att dbstruct par
2ef0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2f00: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
2f10: 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 29 un-name-from-id)
2f20: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2f30: 64 62 3a 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d db:get-run-name-
2f40: 66 72 6f 6d 2d 69 64 20 64 62 73 74 72 75 63 74 from-id dbstruct
2f50: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
2f70: 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 et-main-run-stat
2f80: 73 29 20 20 20 20 20 20 20 20 20 20 20 28 61 70 s) (ap
2f90: 70 6c 79 20 64 62 3a 67 65 74 2d 6d 61 69 6e 2d ply db:get-main-
2fa0: 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 run-stats dbstru
2fb0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2fd0: 28 67 65 74 2d 76 61 72 29 20 20 20 20 20 20 20 (get-var)
2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2ff0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 76 61 72 apply db:get-var
3000: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3010: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3020: 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d ((get-run-
3030: 73 74 61 74 73 29 20 20 20 20 20 20 20 20 20 20 stats)
3040: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3050: 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 get-run-stats db
3060: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3070: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3080: 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 ;; STEPS.
3090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30a0: 28 28 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 ((get-steps-data
30b0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
30c0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 (apply db:get-st
30d0: 65 70 73 2d 64 61 74 61 20 64 62 73 74 72 75 63 eps-data dbstruc
30e0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
30f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3100: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
3110: 73 74 29 20 20 20 20 20 20 20 20 20 20 20 28 61 st) (a
3120: 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 65 70 pply db:get-step
3130: 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 73 74 72 s-for-test dbstr
3140: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 uct params))..
3150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3160: 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 ;; TEST DATA.
3170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3180: 20 28 28 72 65 61 64 2d 74 65 73 74 2d 64 61 74 ((read-test-dat
3190: 61 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 a)
31a0: 20 28 61 70 70 6c 79 20 64 62 3a 72 65 61 64 2d (apply db:read-
31b0: 74 65 73 74 2d 64 61 74 61 20 64 62 73 74 72 75 test-data dbstru
31c0: 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 ct params))..
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31e0: 3b 3b 20 4d 49 53 43 0a 20 20 20 20 20 20 20 20 ;; MISC.
31f0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3200: 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 -latest-host-loa
3210: 64 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c d) (appl
3220: 79 20 64 62 3a 67 65 74 2d 6c 61 74 65 73 74 2d y db:get-latest-
3230: 68 6f 73 74 2d 6c 6f 61 64 20 64 62 73 74 72 75 host-load dbstru
3240: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3260: 28 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 (have-incomplete
3270: 73 3f 29 20 20 20 20 20 20 20 20 20 20 20 20 28 s?) (
3280: 61 70 70 6c 79 20 64 62 3a 68 61 76 65 2d 69 6e apply db:have-in
3290: 63 6f 6d 70 6c 65 74 65 73 3f 20 64 62 73 74 72 completes? dbstr
32a0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
32b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
32c0: 28 28 6c 6f 67 69 6e 29 20 20 20 20 20 20 20 20 ((login)
32d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
32e0: 28 61 70 70 6c 79 20 64 62 3a 6c 6f 67 69 6e 20 (apply db:login
32f0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3300: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3310: 20 20 20 20 20 28 28 67 65 6e 65 72 61 6c 2d 63 ((general-c
3320: 61 6c 6c 29 20 20 20 20 20 20 20 20 20 20 20 20 all)
3330: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 6d 74 (let ((stmt
3340: 6e 61 6d 65 20 20 20 28 63 61 72 20 70 61 72 61 name (car para
3350: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
3360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
3390: 75 6e 2d 69 64 20 20 20 20 20 28 63 61 64 72 20 un-id (cadr
33a0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
33b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33e0: 20 20 28 72 65 61 6c 70 61 72 61 6d 73 20 28 63 (realparams (c
33f0: 64 64 72 20 70 61 72 61 6d 73 29 29 29 0a 20 20 ddr params))).
3400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3430: 20 20 20 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 (db:general-c
3440: 61 6c 6c 20 64 62 73 74 72 75 63 74 20 73 74 6d all dbstruct stm
3450: 74 6e 61 6d 65 20 72 65 61 6c 70 61 72 61 6d 73 tname realparams
3460: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
3470: 20 20 20 20 20 20 20 28 28 73 64 62 2d 71 72 79 ((sdb-qry
3480: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3490: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 73 64 (apply sd
34a0: 62 3a 71 72 79 20 70 61 72 61 6d 73 29 29 0a 20 b:qry params)).
34b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34c0: 20 20 28 28 70 69 6e 67 29 20 20 20 20 20 20 20 ((ping)
34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34e0: 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 (current-proce
34f0: 73 73 2d 69 64 29 29 0a 09 09 20 20 20 28 28 67 ss-id))... ((g
3500: 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 et-changed-recor
3510: 64 2d 69 64 73 29 20 20 20 20 20 20 20 28 61 70 d-ids) (ap
3520: 70 6c 79 20 64 62 3a 67 65 74 2d 63 68 61 6e 67 ply db:get-chang
3530: 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 64 62 ed-record-ids db
3540: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3550: 09 09 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 .. .
3560: 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 53 54 ;; TEST
3570: 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 20 20 META.
3580: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 6d 65 ((testme
3590: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 29 20 20 ta-get-record)
35a0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
35b0: 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f estmeta-get-reco
35c0: 72 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 rd dbstruct para
35d0: 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 ms))..
35e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 53 4b ;; TASK
35f0: 53 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 S .
3600: 20 20 20 20 20 20 28 28 66 69 6e 64 2d 74 61 73 ((find-tas
3610: 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 29 k-queue-records)
3620: 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 3a (apply tasks:
3630: 66 69 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d find-task-queue-
3640: 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 63 74 records dbstruct
3650: 20 70 61 72 61 6d 73 29 29 29 29 29 29 0a 20 20 params)))))).
3660: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 77 72 (if (not wr
3670: 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f 6e itecmd-in-readon
3680: 6c 79 2d 6d 6f 64 65 29 0a 20 20 20 20 20 20 20 ly-mode).
3690: 20 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 61 (let ((delta
36a0: 2d 74 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d -t (- (current-m
36b0: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 0a 20 20 20 illiseconds).
36c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36d0: 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 2d start-
36e0: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
36f0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
3700: 74 21 20 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d t! *db-api-call-
3710: 74 69 6d 65 2a 20 63 6d 64 0a 20 20 20 20 20 20 time* cmd.
3720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3730: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 64 65 (cons de
3740: 6c 74 61 2d 74 20 28 68 61 73 68 2d 74 61 62 6c lta-t (hash-tabl
3750: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 64 e-ref/default *d
3760: 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d 65 2a b-api-call-time*
3770: 20 63 6d 64 20 27 28 29 29 29 29 0a 20 20 20 20 cmd '()))).
3780: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
3790: 20 23 74 20 72 65 73 29 29 0a 20 20 20 20 20 20 #t res)).
37a0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 (vector #f
37b0: 72 65 73 29 29 29 29 29 29 29 0a 0a 3b 3b 20 68 res)))))))..;; h
37c0: 74 74 70 2d 73 65 72 76 65 72 20 20 73 65 6e 64 ttp-server send
37d0: 2d 72 65 73 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 -response.;;
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 70 69 api
37f0: 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 :process-request
3800: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
3810: 20 20 20 20 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b db:*.;;.;
3820: 3b 20 4e 42 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 ; NB// Runs on t
3830: 68 65 20 73 65 72 76 65 72 20 61 73 20 70 61 72 he server as par
3840: 74 20 6f 66 20 74 68 65 20 73 65 72 76 65 72 20 t of the server
3850: 6c 6f 6f 70 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 loop.;;.(define
3860: 28 61 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 (api:process-req
3870: 75 65 73 74 20 64 62 73 74 72 75 63 74 20 24 29 uest dbstruct $)
3880: 20 3b 3b 20 74 68 65 20 24 20 69 73 20 74 68 65 ;; the $ is the
3890: 20 72 65 71 75 65 73 74 20 76 61 72 73 20 70 72 request vars pr
38a0: 6f 63 0a 20 20 28 73 65 74 21 20 2a 61 70 69 2d oc. (set! *api-
38b0: 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d process-request-
38c0: 63 6f 75 6e 74 2a 20 28 2b 20 2a 61 70 69 2d 70 count* (+ *api-p
38d0: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
38e0: 6f 75 6e 74 2a 20 31 29 29 0a 20 20 28 6c 65 74 ount* 1)). (let
38f0: 2a 20 28 28 63 6d 64 20 20 20 20 20 28 24 20 27 * ((cmd ($ '
3900: 63 6d 64 29 29 0a 09 20 28 70 61 72 61 6d 73 6a cmd)).. (paramsj
3910: 20 28 24 20 27 70 61 72 61 6d 73 29 29 0a 09 20 ($ 'params))..
3920: 28 70 61 72 61 6d 73 20 20 28 64 62 3a 73 74 72 (params (db:str
3930: 69 6e 67 2d 3e 6f 62 6a 20 70 61 72 61 6d 73 6a ing->obj paramsj
3940: 20 74 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 transport: 'htt
3950: 70 29 29 20 3b 3b 20 28 72 6d 74 3a 6a 73 6f 6e p)) ;; (rmt:json
3960: 2d 73 74 72 2d 3e 64 61 74 20 70 61 72 61 6d 73 -str->dat params
3970: 6a 29 29 0a 09 20 28 72 65 73 64 61 74 20 20 28 j)).. (resdat (
3980: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
3990: 65 73 74 73 20 64 62 73 74 72 75 63 74 20 28 76 ests dbstruct (v
39a0: 65 63 74 6f 72 20 63 6d 64 20 70 61 72 61 6d 73 ector cmd params
39b0: 29 29 29 20 3b 3b 20 23 28 20 66 6c 61 67 20 72 ))) ;; #( flag r
39c0: 65 73 75 6c 74 20 29 0a 09 20 28 72 65 73 20 20 esult ).. (res
39d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
39e0: 65 73 64 61 74 20 31 29 29 29 0a 20 20 20 20 28 esdat 1))). (
39f0: 69 66 20 28 3e 20 2a 61 70 69 2d 70 72 6f 63 65 if (> *api-proce
3a00: 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 ss-request-count
3a10: 2a 20 2a 6d 61 78 2d 61 70 69 2d 70 72 6f 63 65 * *max-api-proce
3a20: 73 73 2d 72 65 71 75 65 73 74 73 2a 29 0a 09 28 ss-requests*)..(
3a30: 73 65 74 21 20 2a 6d 61 78 2d 61 70 69 2d 70 72 set! *max-api-pr
3a40: 6f 63 65 73 73 2d 72 65 71 75 65 73 74 73 2a 20 ocess-requests*
3a50: 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 *api-process-req
3a60: 75 65 73 74 2d 63 6f 75 6e 74 2a 29 29 0a 20 20 uest-count*)).
3a70: 20 20 28 73 65 74 21 20 2a 61 70 69 2d 70 72 6f (set! *api-pro
3a80: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
3a90: 6e 74 2a 20 28 2d 20 2a 61 70 69 2d 70 72 6f 63 nt* (- *api-proc
3aa0: 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e ess-request-coun
3ab0: 74 2a 20 31 29 29 0a 20 20 20 20 3b 3b 20 54 68 t* 1)). ;; Th
3ac0: 69 73 20 63 61 6e 20 62 65 20 68 65 72 65 20 62 is can be here b
3ad0: 75 74 20 6e 65 65 64 73 20 63 6f 6e 74 72 6f 6c ut needs control
3ae0: 73 20 74 6f 20 65 6e 73 75 72 65 20 69 74 20 64 s to ensure it d
3af0: 6f 65 73 6e 27 74 20 72 75 6e 20 6d 6f 72 65 20 oesn't run more
3b00: 74 68 61 6e 20 65 76 65 72 79 20 34 20 73 65 63 than every 4 sec
3b10: 6f 6e 64 73 0a 20 20 20 20 3b 3b 20 28 72 6d 74 onds. ;; (rmt
3b20: 3a 64 61 74 2d 3e 6a 73 6f 6e 2d 73 74 72 0a 20 :dat->json-str.
3b30: 20 20 20 3b 3b 20 20 28 69 66 20 28 6f 72 20 28 ;; (if (or (
3b40: 73 74 72 69 6e 67 3f 20 72 65 73 29 0a 20 20 20 string? res).
3b50: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 28 6c 69 ;; (li
3b60: 73 74 3f 20 20 20 72 65 73 29 0a 20 20 20 20 3b st? res). ;
3b70: 3b 20 20 20 20 20 20 20 20 20 20 28 6e 75 6d 62 ; (numb
3b80: 65 72 3f 20 72 65 73 29 0a 20 20 20 20 3b 3b 20 er? res). ;;
3b90: 20 20 20 20 20 20 20 20 20 28 62 6f 6f 6c 65 61 (boolea
3ba0: 6e 3f 20 72 65 73 29 29 0a 20 20 20 20 3b 3b 20 n? res)). ;;
3bb0: 20 20 20 20 20 72 65 73 20 0a 20 20 20 20 3b 3b res . ;;
3bc0: 20 20 20 20 20 20 28 6c 69 73 74 20 22 45 52 52 (list "ERR
3bd0: 4f 52 2c 20 6e 6f 74 20 73 74 72 69 6e 67 2c 20 OR, not string,
3be0: 6c 69 73 74 2c 20 6e 75 6d 62 65 72 20 6f 72 20 list, number or
3bf0: 62 6f 6f 6c 65 61 6e 22 20 31 20 63 6d 64 20 70 boolean" 1 cmd p
3c00: 61 72 61 6d 73 20 72 65 73 29 29 29 29 29 0a 20 arams res))))).
3c10: 20 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 (db:obj->stri
3c20: 6e 67 20 72 65 73 20 74 72 61 6e 73 70 6f 72 74 ng res transport
3c30: 3a 20 27 68 74 74 70 29 29 29 0a 0a : 'http)))..