Artifact
4139847db350d46af01b5102954010b50e02cc0f:
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 31 37 2c 20 4d 61 74 74 right 2017, Matt
0060: 68 65 77 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 hew Welland..;;
0070: 0a 3b 3b 20 54 68 69 73 20 66 69 6c 65 20 69 73 .;; This file is
0080: 20 70 61 72 74 20 6f 66 20 4d 65 67 61 74 65 73 part of Megates
0090: 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 t..;; .;; Me
00a0: 67 61 74 65 73 74 20 69 73 20 66 72 65 65 20 73 gatest is free s
00b0: 6f 66 74 77 61 72 65 3a 20 79 6f 75 20 63 61 6e oftware: you can
00c0: 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 74 redistribute it
00d0: 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b and/or modify.;
00e0: 3b 20 20 20 20 20 69 74 20 75 6e 64 65 72 20 74 ; it under t
00f0: 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 he terms of the
0100: 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c GNU General Publ
0110: 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 ic License as pu
0120: 62 6c 69 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 blished by.;;
0130: 20 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 77 the Free Softw
0140: 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 are Foundation,
0150: 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 33 either version 3
0160: 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 2c of the License,
0170: 20 6f 72 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 or.;; (at y
0180: 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 our option) any
0190: 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b later version..;
01a0: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
01b0: 73 74 20 69 73 20 64 69 73 74 72 69 62 75 74 65 st is distribute
01c0: 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 d in the hope th
01d0: 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 at it will be us
01e0: 65 66 75 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 eful,.;; but
01f0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
0200: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
0210: 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 20 ven the implied
0220: 77 61 72 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 warranty of.;;
0230: 20 20 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 MERCHANTABILI
0240: 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f TY or FITNESS FO
0250: 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 R A PARTICULAR P
0260: 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 URPOSE. See the
0270: 0a 3b 3b 20 20 20 20 20 47 4e 55 20 47 65 6e 65 .;; GNU Gene
0280: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
0290: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 se for more deta
02a0: 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 ils..;; .;;
02b0: 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 You should have
02c0: 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 received a copy
02d0: 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 of the GNU Gener
02e0: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
02f0: 65 0a 3b 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 e.;; along w
0300: 69 74 68 20 4d 65 67 61 74 65 73 74 2e 20 20 49 ith Megatest. I
0310: 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 f not, see <http
0320: 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c ://www.gnu.org/l
0330: 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d icenses/>...;;==
0340: 3d 3d 3d 3d 3d 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 0a 0a 28 64 65 63 6c 61 72 65 20 28 ====..(declare (
0390: 75 6e 69 74 20 61 70 69 6d 6f 64 29 29 0a 28 64 unit apimod)).(d
03a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d eclare (uses com
03b0: 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 monmod)).(declar
03c0: 65 20 28 75 73 65 73 20 64 65 62 75 67 70 72 69 e (uses debugpri
03d0: 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 nt)).(declare (u
03e0: 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 64 65 63 ses dbmod)).(dec
03f0: 6c 61 72 65 20 28 75 73 65 73 20 74 61 73 6b 73 lare (uses tasks
0400: 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 )).;; (declare (
0410: 75 73 65 73 20 73 65 72 76 65 72 6d 6f 64 29 29 uses servermod))
0420: 0a 0a 28 6d 6f 64 75 6c 65 20 61 70 69 6d 6f 64 ..(module apimod
0430: 0a 09 2a 0a 09 0a 28 69 6d 70 6f 72 74 20 73 63 ..*...(import sc
0440: 68 65 6d 65 20 63 68 69 63 6b 65 6e 20 64 61 74 heme chicken dat
0450: 61 2d 73 74 72 75 63 74 75 72 65 73 20 65 78 74 a-structures ext
0460: 72 61 73 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 ras).(import (pr
0470: 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c efix sqlite3 sql
0480: 69 74 65 33 3a 29 20 70 6f 73 69 78 20 74 79 70 ite3:) posix typ
0490: 65 64 2d 72 65 63 6f 72 64 73 20 73 72 66 69 2d ed-records srfi-
04a0: 31 38 20 73 72 66 69 2d 36 39 29 0a 28 69 6d 70 18 srfi-69).(imp
04b0: 6f 72 74 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 0a 28 ort commonmod).(
04c0: 69 6d 70 6f 72 74 20 64 65 62 75 67 70 72 69 6e import debugprin
04d0: 74 29 0a 28 69 6d 70 6f 72 74 20 64 62 6d 6f 64 t).(import dbmod
04e0: 29 0a 28 69 6d 70 6f 72 74 20 74 61 73 6b 73 29 ).(import tasks)
04f0: 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 73 65 72 76 .;; (import serv
0500: 65 72 6d 6f 64 29 0a 0a 3b 3b 20 61 6c 6c 6f 77 ermod)..;; allow
0510: 20 74 68 65 73 65 20 71 75 65 72 69 65 73 20 74 these queries t
0520: 68 72 6f 75 67 68 20 77 69 74 68 6f 75 74 20 73 hrough without s
0530: 74 61 72 74 69 6e 67 20 61 20 73 65 72 76 65 72 tarting a server
0540: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 61 70 69 3a .;;.(define api:
0550: 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 read-only-querie
0560: 73 0a 20 20 27 28 67 65 74 2d 6b 65 79 2d 76 61 s. '(get-key-va
0570: 6c 2d 70 61 69 72 73 0a 20 20 20 20 67 65 74 2d l-pairs. get-
0580: 76 61 72 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 var. get-keys
0590: 0a 20 20 20 20 67 65 74 2d 6b 65 79 2d 76 61 6c . get-key-val
05a0: 73 0a 20 20 20 20 74 65 73 74 2d 74 6f 70 6c 65 s. test-tople
05b0: 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 0a 20 20 vel-num-items.
05c0: 20 20 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d get-test-info-
05d0: 62 79 2d 69 64 0a 20 20 20 20 67 65 74 2d 73 74 by-id. get-st
05e0: 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a 20 eps-info-by-id.
05f0: 20 20 20 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f get-data-info
0600: 2d 62 79 2d 69 64 0a 20 20 20 20 74 65 73 74 2d -by-id. test-
0610: 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d get-rundir-from-
0620: 74 65 73 74 2d 69 64 0a 20 20 20 20 67 65 74 2d test-id. get-
0630: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
0640: 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 ing-for-testname
0650: 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 . get-count-t
0660: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 0a 20 20 20 ests-running.
0670: 20 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 get-count-tests
0680: 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 -running-in-jobg
0690: 72 6f 75 70 0a 20 20 20 20 67 65 74 2d 70 72 65 roup. get-pre
06a0: 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 vious-test-run-r
06b0: 65 63 6f 72 64 0a 20 20 20 20 67 65 74 2d 6d 61 ecord. get-ma
06c0: 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d tching-previous-
06d0: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 test-run-records
06e0: 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d 6c 6f . test-get-lo
06f0: 67 66 69 6c 65 2d 69 6e 66 6f 0a 20 20 20 20 74 gfile-info. t
0700: 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d est-get-records-
0710: 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 0a 20 for-index-file.
0720: 20 20 20 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d get-testinfo-
0730: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 state-status.
0740: 20 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 test-get-top-pr
0750: 6f 63 65 73 73 2d 70 69 64 0a 20 20 20 20 74 65 ocess-pid. te
0760: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
0770: 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 ching-keynames-t
0780: 61 72 67 65 74 2d 6e 65 77 0a 20 20 20 20 67 65 arget-new. ge
0790: 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 t-prereqs-not-me
07a0: 74 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d t. get-count-
07b0: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f tests-running-fo
07c0: 72 2d 72 75 6e 2d 69 64 0a 20 20 20 20 67 65 74 r-run-id. get
07d0: 2d 72 75 6e 2d 69 6e 66 6f 0a 20 20 20 20 67 65 -run-info. ge
07e0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 0a 20 20 20 t-run-status.
07f0: 20 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 0a 20 get-run-state.
0800: 20 20 20 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 get-run-stats
0810: 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 74 69 6d . get-run-tim
0820: 65 73 0a 20 20 20 20 67 65 74 2d 74 61 72 67 65 es. get-targe
0830: 74 73 0a 20 20 20 20 67 65 74 2d 74 61 72 67 65 ts. get-targe
0840: 74 0a 20 20 20 20 3b 3b 20 72 65 67 69 73 74 65 t. ;; registe
0850: 72 2d 72 75 6e 0a 20 20 20 20 67 65 74 2d 74 65 r-run. get-te
0860: 73 74 73 2d 74 61 67 73 0a 20 20 20 20 67 65 74 sts-tags. get
0870: 2d 74 65 73 74 2d 74 69 6d 65 73 0a 20 20 20 20 -test-times.
0880: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
0890: 6e 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d n. get-tests-
08a0: 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 for-run-state-st
08b0: 61 74 75 73 0a 20 20 20 20 67 65 74 2d 74 65 73 atus. get-tes
08c0: 74 2d 69 64 0a 20 20 20 20 67 65 74 2d 74 65 73 t-id. get-tes
08d0: 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 ts-for-runs-mind
08e0: 61 74 61 0a 20 20 20 20 67 65 74 2d 74 65 73 74 ata. get-test
08f0: 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 s-for-run-mindat
0900: 61 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 6e 61 a. get-run-na
0910: 6d 65 2d 66 72 6f 6d 2d 69 64 0a 20 20 20 20 67 me-from-id. g
0920: 65 74 2d 72 75 6e 73 0a 20 20 20 20 73 69 6d 70 et-runs. simp
0930: 6c 65 2d 67 65 74 2d 72 75 6e 73 0a 20 20 20 20 le-get-runs.
0940: 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 0a 20 20 20 get-num-runs.
0950: 20 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 get-runs-cnt-by
0960: 2d 70 61 74 74 0a 20 20 20 20 67 65 74 2d 61 6c -patt. get-al
0970: 6c 2d 72 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 l-run-ids. ge
0980: 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 0a 20 t-prev-run-ids.
0990: 20 20 20 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d get-run-ids-m
09a0: 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 0a 20 atching-target.
09b0: 20 20 20 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 get-runs-by-p
09c0: 61 74 74 0a 20 20 20 20 67 65 74 2d 73 74 65 70 att. get-step
09d0: 73 2d 64 61 74 61 0a 20 20 20 20 67 65 74 2d 73 s-data. get-s
09e0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 teps-for-test.
09f0: 20 20 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 read-test-data
0a00: 0a 20 20 20 20 72 65 61 64 2d 74 65 73 74 2d 64 . read-test-d
0a10: 61 74 61 2d 61 6c 74 0a 20 20 20 20 6c 6f 67 69 ata-alt. logi
0a20: 6e 0a 20 20 20 20 74 61 73 6b 73 2d 67 65 74 2d n. tasks-get-
0a30: 6c 61 73 74 0a 20 20 20 20 74 65 73 74 6d 65 74 last. testmet
0a40: 61 2d 67 65 74 2d 72 65 63 6f 72 64 0a 20 20 20 a-get-record.
0a50: 20 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 have-incomplete
0a60: 73 3f 0a 20 20 20 20 3b 3b 20 73 79 6e 63 68 61 s?. ;; syncha
0a70: 73 68 2d 67 65 74 0a 20 20 20 20 67 65 74 2d 63 sh-get. get-c
0a80: 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 hanged-record-id
0a90: 73 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 72 65 s. get-run-re
0aa0: 63 6f 72 64 2d 69 64 73 20 0a 20 20 20 20 67 65 cord-ids . ge
0ab0: 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d t-not-completed-
0ac0: 63 6e 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 61 cnt))..(define a
0ad0: 70 69 3a 77 72 69 74 65 2d 71 75 65 72 69 65 73 pi:write-queries
0ae0: 0a 20 20 27 28 0a 20 20 20 20 67 65 74 2d 6b 65 . '(. get-ke
0af0: 79 73 2d 77 72 69 74 65 20 3b 3b 20 64 75 6d 6d ys-write ;; dumm
0b00: 79 20 22 77 72 69 74 65 22 20 71 75 65 72 79 20 y "write" query
0b10: 74 6f 20 66 6f 72 63 65 20 73 65 72 76 65 72 20 to force server
0b20: 73 74 61 72 74 0a 0a 20 20 20 20 3b 3b 20 53 45 start.. ;; SE
0b30: 52 56 45 52 53 0a 20 20 20 20 73 74 61 72 74 2d RVERS. start-
0b40: 73 65 72 76 65 72 0a 20 20 20 20 6b 69 6c 6c 2d server. kill-
0b50: 73 65 72 76 65 72 0a 0a 20 20 20 20 3b 3b 20 54 server.. ;; T
0b60: 45 53 54 53 0a 20 20 20 20 74 65 73 74 2d 73 65 ESTS. test-se
0b70: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
0b80: 79 2d 69 64 0a 20 20 20 20 64 65 6c 65 74 65 2d y-id. delete-
0b90: 74 65 73 74 2d 72 65 63 6f 72 64 73 0a 20 20 20 test-records.
0ba0: 20 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 delete-old-dele
0bb0: 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ted-test-records
0bc0: 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 73 74 . test-set-st
0bd0: 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 20 74 ate-status. t
0be0: 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 est-set-top-proc
0bf0: 65 73 73 2d 70 69 64 0a 20 20 20 20 73 65 74 2d ess-pid. set-
0c00: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 state-status-and
0c10: 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 -roll-up-items.
0c20: 20 20 20 0a 20 20 20 20 75 70 64 61 74 65 2d 70 . update-p
0c30: 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 0a ass-fail-counts.
0c40: 20 20 20 20 74 6f 70 2d 74 65 73 74 2d 73 65 74 top-test-set
0c50: 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 3b -per-pf-counts ;
0c60: 3b 20 28 64 62 3a 74 6f 70 2d 74 65 73 74 2d 73 ; (db:top-test-s
0c70: 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 et-per-pf-counts
0c80: 20 28 64 62 3a 67 65 74 2d 64 62 20 2a 64 62 2a (db:get-db *db*
0c90: 20 35 29 20 35 20 22 72 75 6e 66 69 72 73 74 22 5) 5 "runfirst"
0ca0: 29 0a 0a 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 ).. ;; RUNS.
0cb0: 20 20 20 72 65 67 69 73 74 65 72 2d 72 75 6e 0a register-run.
0cc0: 20 20 20 20 73 65 74 2d 74 65 73 74 73 2d 73 74 set-tests-st
0cd0: 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 20 64 ate-status. d
0ce0: 65 6c 65 74 65 2d 72 75 6e 0a 20 20 20 20 6c 6f elete-run. lo
0cf0: 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 0a 20 20 ck/unlock-run.
0d00: 20 20 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 update-run-eve
0d10: 6e 74 5f 74 69 6d 65 0a 20 20 20 20 6d 61 72 6b nt_time. mark
0d20: 2d 69 6e 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 -incomplete.
0d30: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
0d40: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
0d50: 0a 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 . ;; STEPS.
0d60: 20 20 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 teststep-set-s
0d70: 74 61 74 75 73 21 0a 20 20 20 20 64 65 6c 65 74 tatus!. delet
0d80: 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 e-steps-for-test
0d90: 0a 20 20 20 20 3b 3b 20 54 45 53 54 20 44 41 54 . ;; TEST DAT
0da0: 41 0a 20 20 20 20 74 65 73 74 2d 64 61 74 61 2d A. test-data-
0db0: 72 6f 6c 6c 75 70 0a 20 20 20 20 63 73 76 2d 3e rollup. csv->
0dc0: 74 65 73 74 2d 64 61 74 61 0a 0a 20 20 20 20 3b test-data.. ;
0dd0: 3b 20 4d 49 53 43 0a 20 20 20 20 73 79 6e 63 2d ; MISC. sync-
0de0: 69 6e 6d 65 6d 2d 3e 64 62 0a 20 20 20 20 64 72 inmem->db. dr
0df0: 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 0a op-all-triggers.
0e00: 20 20 20 20 63 72 65 61 74 65 2d 61 6c 6c 2d 74 create-all-t
0e10: 72 69 67 67 65 72 73 0a 20 20 20 20 75 70 64 61 riggers. upda
0e20: 74 65 2d 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 te-tesdata-on-re
0e30: 70 69 6c 63 61 74 65 2d 64 62 20 0a 0a 20 20 20 pilcate-db ..
0e40: 20 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 ;; TESTMETA.
0e50: 20 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 testmeta-add-re
0e60: 63 6f 72 64 0a 20 20 20 20 74 65 73 74 6d 65 74 cord. testmet
0e70: 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 0a 0a a-update-field..
0e80: 20 20 20 20 3b 3b 20 54 41 53 4b 53 0a 20 20 20 ;; TASKS.
0e90: 20 74 61 73 6b 73 2d 61 64 64 0a 20 20 20 20 74 tasks-add. t
0ea0: 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 asks-set-state-g
0eb0: 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 0a 20 iven-param-key.
0ec0: 20 20 20 29 29 0a 3b 3b 20 54 68 65 73 65 20 61 )).;; These a
0ed0: 72 65 20 63 61 6c 6c 65 64 20 62 79 20 74 68 65 re called by the
0ee0: 20 73 65 72 76 65 72 20 6f 6e 20 72 65 63 69 70 server on recip
0ef0: 74 20 6f 66 20 2f 61 70 69 20 63 61 6c 6c 73 0a t of /api calls.
0f00: 3b 3b 20 20 20 20 2d 20 6b 65 65 70 20 69 74 20 ;; - keep it
0f10: 73 69 6d 70 6c 65 2c 20 6f 6e 6c 79 20 72 65 74 simple, only ret
0f20: 75 72 6e 20 74 68 65 20 61 63 74 75 61 6c 20 72 urn the actual r
0f30: 65 73 75 6c 74 20 6f 66 20 74 68 65 20 63 61 6c esult of the cal
0f40: 6c 2c 20 69 2e 65 2e 20 6e 6f 20 6d 65 74 61 20 l, i.e. no meta
0f50: 69 6e 66 6f 20 68 65 72 65 0a 3b 3b 0a 3b 3b 20 info here.;;.;;
0f60: 20 20 20 2d 20 72 65 74 75 72 6e 73 20 23 28 20 - returns #(
0f70: 66 6c 61 67 20 72 65 73 75 6c 74 20 29 0a 3b 3b flag result ).;;
0f80: 0a 28 64 65 66 69 6e 65 20 28 61 70 69 3a 65 78 .(define (api:ex
0f90: 65 63 75 74 65 2d 72 65 71 75 65 73 74 73 20 64 ecute-requests d
0fa0: 62 73 74 72 75 63 74 20 64 61 74 29 0a 20 20 28 bstruct dat). (
0fb0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
0fc0: 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 6c 65 74 s. exn. (let
0fd0: 20 28 28 63 61 6c 6c 2d 63 68 61 69 6e 20 28 67 ((call-chain (g
0fe0: 65 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 29 29 et-call-chain)))
0ff0: 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
1000: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
1010: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
1020: 3a 20 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 : api:execute-re
1030: 71 75 65 73 74 73 20 72 65 63 65 69 76 65 64 20 quests received
1040: 61 6e 20 65 78 63 65 70 74 69 6f 6e 20 66 72 6f an exception fro
1050: 6d 20 70 65 65 72 2c 20 64 61 74 3d 22 20 64 61 m peer, dat=" da
1060: 74 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a t ", exn=" exn).
1070: 20 20 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c (print-call
1080: 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d -chain (current-
1090: 65 72 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 20 error-port)).
10a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
10b0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
10c0: 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 rt* " message: "
10d0: 20 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 ((condition-pr
10e0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
10f0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
1100: 78 6e 29 29 20 20 20 20 20 20 20 0a 20 20 20 20 xn)) .
1110: 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 (vector #f (vec
1120: 74 6f 72 20 65 78 6e 20 63 61 6c 6c 2d 63 68 61 tor exn call-cha
1130: 69 6e 20 64 61 74 29 29 29 20 3b 3b 20 72 65 74 in dat))) ;; ret
1140: 75 72 6e 20 73 6f 6d 65 20 73 74 75 66 66 20 66 urn some stuff f
1150: 6f 72 20 64 65 62 75 67 20 69 66 20 61 6e 20 65 or debug if an e
1160: 78 63 65 70 74 69 6f 6e 20 68 61 70 70 65 6e 73 xception happens
1170: 0a 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 28 28 . (cond. ((
1180: 6e 6f 74 20 28 76 65 63 74 6f 72 3f 20 64 61 74 not (vector? dat
1190: 29 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ))
11a0: 20 20 20 20 20 20 3b 3b 20 69 74 20 69 73 20 61 ;; it is a
11b0: 6e 20 65 72 72 6f 72 20 74 6f 20 6e 6f 74 20 72 n error to not r
11c0: 65 63 65 69 76 65 20 61 20 76 65 63 74 6f 72 0a eceive a vector.
11d0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 (vector #f
11e0: 28 76 65 63 74 6f 72 20 23 66 20 22 72 65 6d 6f (vector #f "remo
11f0: 74 65 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 te must be calle
1200: 64 20 77 69 74 68 20 61 20 76 65 63 74 6f 72 22 d with a vector"
1210: 29 29 29 0a 20 20 20 20 28 28 3e 20 2a 61 70 69 ))). ((> *api
1220: 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 -process-request
1230: 2d 63 6f 75 6e 74 2a 20 32 30 29 20 3b 3b 20 32 -count* 20) ;; 2
1240: 30 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 0). (debug:p
1250: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
1260: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
1270: 4e 47 3a 20 61 70 69 3a 65 78 65 63 75 74 65 2d NG: api:execute-
1280: 72 65 71 75 65 73 74 73 20 72 65 63 65 69 76 65 requests receive
1290: 64 20 61 6e 20 6f 76 65 72 6c 6f 61 64 65 64 20 d an overloaded
12a0: 6d 65 73 73 61 67 65 2e 22 29 0a 20 20 20 20 20 message.").
12b0: 28 73 65 74 21 20 2a 73 65 72 76 65 72 2d 6f 76 (set! *server-ov
12c0: 65 72 6c 6f 61 64 65 64 2a 20 23 74 29 0a 20 20 erloaded* #t).
12d0: 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 (vector #f (v
12e0: 65 63 74 6f 72 20 23 66 20 27 6f 76 65 72 6c 6f ector #f 'overlo
12f0: 61 64 65 64 29 29 29 20 3b 3b 20 74 68 65 20 69 aded))) ;; the i
1300: 6e 6e 65 72 20 76 65 63 74 6f 72 20 69 73 20 77 nner vector is w
1310: 68 61 74 20 67 65 74 73 20 72 65 74 75 72 6e 65 hat gets returne
1320: 64 2e 20 6e 6f 70 65 2c 20 64 6f 6e 27 74 20 6b d. nope, don't k
1330: 6e 6f 77 20 77 68 79 2e 20 70 6c 65 61 73 65 20 now why. please
1340: 72 65 66 61 63 74 6f 72 21 0a 20 20 20 20 28 65 refactor!. (e
1350: 6c 73 65 20 20 0a 20 20 20 20 20 28 6c 65 74 2a lse . (let*
1360: 20 28 28 63 6d 64 2d 69 6e 20 20 20 20 20 20 20 ((cmd-in
1370: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
1380: 20 64 61 74 20 30 29 29 0a 20 20 20 20 20 20 20 dat 0)).
1390: 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 (cmd
13a0: 20 20 20 20 20 20 20 20 28 69 66 20 28 73 79 6d (if (sym
13b0: 62 6f 6c 3f 20 63 6d 64 2d 69 6e 29 0a 09 09 09 bol? cmd-in)....
13c0: 09 20 20 20 63 6d 64 2d 69 6e 0a 09 09 09 09 20 . cmd-in.....
13d0: 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f (string->symbo
13e0: 6c 20 63 6d 64 2d 69 6e 29 29 29 0a 20 20 20 20 l cmd-in))).
13f0: 20 20 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 (params
1400: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
1410: 6f 72 2d 72 65 66 20 64 61 74 20 31 29 29 0a 20 or-ref dat 1)).
1420: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 72 (star
1430: 74 2d 74 20 20 20 20 20 20 20 20 20 20 20 28 63 t-t (c
1440: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f urrent-milliseco
1450: 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 nds)).
1460: 20 20 28 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 (readonly-mode
1470: 20 20 20 20 20 28 64 62 72 3a 64 62 73 74 72 75 (dbr:dbstru
1480: 63 74 2d 72 65 61 64 2d 6f 6e 6c 79 20 64 62 73 ct-read-only dbs
1490: 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 truct)).
14a0: 20 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d 63 6f (readonly-co
14b0: 6d 6d 61 6e 64 20 20 28 6d 65 6d 62 65 72 20 63 mmand (member c
14c0: 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 md api:read-only
14d0: 2d 71 75 65 72 69 65 73 29 29 0a 20 20 20 20 20 -queries)).
14e0: 20 20 20 20 20 20 20 28 77 72 69 74 65 63 6d 64 (writecmd
14f0: 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 -in-readonly-mod
1500: 65 20 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 2d e (and readonly-
1510: 6d 6f 64 65 20 28 6e 6f 74 20 72 65 61 64 6f 6e mode (not readon
1520: 6c 79 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 20 20 ly-command))).
1530: 20 20 20 20 20 20 20 20 20 20 23 3b 28 66 6f 6f #;(foo
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1550: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
1560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1570: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 (common:t
1580: 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f elemetry-log (co
1590: 6e 63 20 22 61 70 69 2d 69 6e 3a 22 28 2d 3e 73 nc "api-in:"(->s
15a0: 74 72 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 tring cmd)).
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e0: 20 20 20 70 61 79 6c 6f 61 64 3a 20 60 28 28 70 payload: `((p
15f0: 61 72 61 6d 73 20 2e 20 2c 70 61 72 61 6d 73 29 arams . ,params)
1600: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1620: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
1630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1640: 20 20 20 20 20 20 23 74 29 29 0a 20 20 20 20 20 #t)).
1650: 20 20 20 20 20 20 20 28 72 65 73 20 20 20 20 0a (res .
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
1670: 20 77 72 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 writecmd-in-rea
1680: 64 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 20 20 20 20 donly-mode.
1690: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
16a0: 63 20 22 61 74 74 65 6d 70 74 20 74 6f 20 72 75 c "attempt to ru
16b0: 6e 20 77 72 69 74 65 20 63 6f 6d 6d 61 6e 64 20 n write command
16c0: 22 63 6d 64 22 20 6f 6e 20 61 20 72 65 61 64 2d "cmd" on a read-
16d0: 6f 6e 6c 79 20 64 61 74 61 62 61 73 65 22 29 0a only database").
16e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16f0: 20 28 63 61 73 65 20 63 6d 64 0a 20 20 20 20 20 (case cmd.
1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1750: 20 20 20 3b 3b 20 52 45 41 44 2f 57 52 49 54 45 ;; READ/WRITE
1760: 20 51 55 45 52 49 45 53 0a 20 20 20 20 20 20 20 QUERIES.
1770: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d ;;==
1780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 =============..
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 28 28 67 65 74 2d 6b 65 79 73 2d 77 72 69 ((get-keys-wri
17d0: 74 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 te)
17e0: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 (db:g
17f0: 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 et-keys dbstruct
1800: 29 29 20 3b 3b 20 66 6f 72 63 65 20 61 20 64 75 )) ;; force a du
1810: 6d 6d 79 20 22 77 72 69 74 65 22 20 71 75 65 72 mmy "write" quer
1820: 79 20 74 6f 20 66 6f 72 63 65 20 73 65 72 76 65 y to force serve
1830: 72 3b 20 66 6f 72 20 64 65 62 75 67 20 69 6e 20 r; for debug in
1840: 2d 72 65 70 6c 0a 20 20 20 20 20 20 20 20 20 20 -repl.
1850: 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 .
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1870: 53 45 52 56 45 52 53 0a 20 20 20 20 20 20 20 20 SERVERS.
1880: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 ;; ((
1890: 73 74 61 72 74 2d 73 65 72 76 65 72 29 20 20 20 start-server)
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b0: 20 28 61 70 70 6c 79 20 73 65 72 76 65 72 3a 6b (apply server:k
18c0: 69 6e 64 2d 72 75 6e 20 70 61 72 61 6d 73 29 29 ind-run params))
18d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
18e0: 20 20 20 20 28 28 6b 69 6c 6c 2d 73 65 72 76 65 ((kill-serve
18f0: 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r)
1900: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 73 65 (set! *se
1910: 72 76 65 72 2d 72 75 6e 2a 20 23 66 29 29 0a 0a rver-run* #f))..
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1930: 20 20 20 3b 3b 20 54 45 53 54 53 0a 0a 20 20 20 ;; TESTS..
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1950: 3b 3b 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 ;;((test-set-sta
1960: 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 29 te-status-by-id)
1970: 20 20 20 20 20 28 61 70 70 6c 79 20 6d 74 3a 74 (apply mt:t
1980: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
1990: 61 74 75 73 2d 62 79 2d 69 64 20 64 62 73 74 72 atus-by-id dbstr
19a0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 3b 3b 42 42 20 2d 20 63 6f 6d 6d 65 6e 74 65 64 ;;BB - commented
19d0: 20 6f 75 74 20 61 62 6f 76 65 20 62 65 63 61 75 out above becau
19e0: 73 65 20 69 74 20 77 61 73 20 63 61 6c 6c 69 6e se it was callin
19f0: 67 20 62 65 6c 6f 77 2c 20 65 76 65 6e 74 75 61 g below, eventua
1a00: 6c 6c 79 2c 20 69 6e 63 6f 72 72 65 63 74 6c 79 lly, incorrectly
1a10: 20 28 64 62 73 74 72 75 63 74 20 70 61 73 73 65 (dbstruct passe
1a20: 64 20 74 6f 20 6d 74 3a 74 65 73 74 2d 73 65 74 d to mt:test-set
1a30: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
1a40: 2d 69 64 2c 20 77 68 69 63 68 20 70 72 65 76 69 -id, which previ
1a50: 6f 73 6c 79 20 64 69 64 20 6d 6f 72 65 2c 20 62 osly did more, b
1a60: 75 74 20 6e 6f 77 20 6f 6e 6c 79 20 70 61 73 73 ut now only pass
1a70: 65 73 20 74 68 72 75 20 74 6f 20 64 62 3a 73 65 es thru to db:se
1a80: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 t-state-status-a
1a90: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 nd-roll-up-items
1aa0: 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
1ab0: 20 20 20 20 20 28 28 74 65 73 74 2d 73 65 74 2d ((test-set-
1ac0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d state-status-by-
1ad0: 69 64 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 id)..
1ae0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 65 66 ;; (def
1af0: 69 6e 65 20 28 64 62 3a 73 65 74 2d 73 74 61 74 ine (db:set-stat
1b00: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
1b10: 6c 2d 75 70 2d 69 74 65 6d 73 20 64 62 73 74 72 l-up-items dbstr
1b20: 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d uct run-id test-
1b30: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
1b40: 74 61 74 65 20 73 74 61 74 75 73 20 63 6f 6d 6d tate status comm
1b50: 65 6e 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ent).
1b60: 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 (db:set
1b70: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
1b80: 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a d-roll-up-items.
1b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ba0: 20 20 20 20 20 64 62 73 74 72 75 63 74 0a 20 20 dbstruct.
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc0: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 (list-ref par
1bd0: 61 6d 73 20 30 29 20 3b 20 72 75 6e 2d 69 64 0a ams 0) ; run-id.
1be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf0: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 (list-ref p
1c00: 61 72 61 6d 73 20 31 29 20 3b 20 74 65 73 74 2d arams 1) ; test-
1c10: 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 name.
1c20: 20 20 20 20 20 20 20 20 20 20 23 66 20 20 20 20 #f
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 ;
1c40: 69 74 65 6d 2d 70 61 74 68 0a 20 20 20 20 20 20 item-path.
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1c60: 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 list-ref params
1c70: 32 29 20 3b 20 73 74 61 74 65 0a 20 20 20 20 20 2) ; state.
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c90: 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 (list-ref params
1ca0: 20 33 29 20 3b 20 73 74 61 74 75 73 0a 20 20 20 3) ; status.
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cc0: 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 (list-ref para
1cd0: 6d 73 20 34 29 20 3b 20 63 6f 6d 6d 65 6e 74 0a ms 4) ; comment.
1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cf0: 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 )).
1d00: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
1d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1d20: 28 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 (delete-test-rec
1d30: 6f 72 64 73 29 20 20 20 20 20 20 20 20 20 20 20 ords)
1d40: 20 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 (apply db:dele
1d50: 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 te-test-records
1d60: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
1d70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1d80: 20 20 20 20 20 28 28 64 65 6c 65 74 65 2d 6f 6c ((delete-ol
1d90: 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 d-deleted-test-r
1da0: 65 63 6f 72 64 73 29 20 28 61 70 70 6c 79 20 64 ecords) (apply d
1db0: 62 3a 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c b:delete-old-del
1dc0: 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 eted-test-record
1dd0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
1de0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
1df0: 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 73 65 ((test-se
1e00: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 t-state-status)
1e10: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
1e20: 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 db:test-set-sta
1e30: 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 te-status dbstru
1e40: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1e60: 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 (test-set-top-pr
1e70: 6f 63 65 73 73 2d 70 69 64 29 20 20 20 20 20 20 ocess-pid)
1e80: 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 (apply db:test
1e90: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
1ea0: 2d 70 69 64 20 64 62 73 74 72 75 63 74 20 70 61 -pid dbstruct pa
1eb0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
1ec0: 20 20 20 20 20 20 20 20 20 20 28 28 73 65 74 2d ((set-
1ed0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 state-status-and
1ee0: 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 29 20 -roll-up-items)
1ef0: 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 73 74 (apply db:set-st
1f00: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
1f10: 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 64 62 73 oll-up-items dbs
1f20: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f40: 20 20 28 28 73 65 74 2d 73 74 61 74 65 2d 73 74 ((set-state-st
1f50: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1f60: 2d 72 75 6e 29 20 28 61 70 70 6c 79 20 64 62 3a -run) (apply db:
1f70: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1f80: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
1f90: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
1fa0: 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
1fb0: 20 20 20 20 20 20 20 28 28 74 6f 70 2d 74 65 73 ((top-tes
1fc0: 74 2d 73 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 t-set-per-pf-cou
1fd0: 6e 74 73 29 20 20 20 20 20 20 28 61 70 70 6c 79 nts) (apply
1fe0: 20 64 62 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 db:top-test-set
1ff0: 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 64 -per-pf-counts d
2000: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2010: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2020: 20 20 20 20 28 28 74 65 73 74 2d 73 65 74 2d 61 ((test-set-a
2030: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 rchive-block-id)
2040: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2050: 3a 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 :test-set-archiv
2060: 65 2d 62 6c 6f 63 6b 2d 69 64 20 64 62 73 74 72 e-block-id dbstr
2070: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 uct params))..
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2090: 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 20 20 20 ;; RUNS.
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 72 65 ((re
20b0: 67 69 73 74 65 72 2d 72 75 6e 29 20 20 20 20 20 gister-run)
20c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
20d0: 6c 79 20 64 62 3a 72 65 67 69 73 74 65 72 2d 72 ly db:register-r
20e0: 75 6e 20 64 62 73 74 72 75 63 74 20 70 61 72 61 un dbstruct para
20f0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2100: 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 74 65 ((set-te
2110: 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73 sts-state-status
2120: 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 ) (apply d
2130: 62 3a 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 b:set-tests-stat
2140: 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 63 e-status dbstruc
2150: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2170: 64 65 6c 65 74 65 2d 72 75 6e 29 20 20 20 20 20 delete-run)
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2190: 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 72 pply db:delete-r
21a0: 75 6e 20 64 62 73 74 72 75 63 74 20 70 61 72 61 un dbstruct para
21b0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
21c0: 20 20 20 20 20 20 20 20 28 28 6c 6f 63 6b 2f 75 ((lock/u
21d0: 6e 6c 6f 63 6b 2d 72 75 6e 29 20 20 20 20 20 20 nlock-run)
21e0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
21f0: 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 b:lock/unlock-ru
2200: 6e 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d n dbstruct param
2210: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2220: 20 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d ((update-
2230: 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 29 20 run-event_time)
2240: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2250: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e :update-run-even
2260: 74 5f 74 69 6d 65 20 64 62 73 74 72 75 63 74 20 t_time dbstruct
2270: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
2280: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 75 70 ((up
2290: 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 29 20 date-run-stats)
22a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
22b0: 6c 79 20 64 62 3a 75 70 64 61 74 65 2d 72 75 6e ly db:update-run
22c0: 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 74 20 -stats dbstruct
22d0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
22e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 ((se
22f0: 74 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 20 t-var)
2300: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
2310: 6c 79 20 64 62 3a 73 65 74 2d 76 61 72 20 64 62 ly db:set-var db
2320: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2340: 20 20 20 28 28 69 6e 63 2d 76 61 72 29 20 20 20 ((inc-var)
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2360: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 69 6e 63 (apply db:inc
2370: 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 70 61 -var dbstruct pa
2380: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 64 65 rams))... ((de
2390: 63 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 20 c-var)
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
23b0: 6c 79 20 64 62 3a 64 65 63 2d 76 61 72 20 64 62 ly db:dec-var db
23c0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
23d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e0: 20 20 20 28 28 64 65 6c 2d 76 61 72 29 20 20 20 ((del-var)
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c (apply db:del
2410: 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 70 61 -var dbstruct pa
2420: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 61 64 rams))... ((ad
2430: 64 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 20 d-var)
2440: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
2450: 6c 79 20 64 62 3a 61 64 64 2d 76 61 72 20 64 62 ly db:add-var db
2460: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2480: 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 ;; STEPS.
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 28 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 ((teststep-set-s
24b0: 74 61 74 75 73 21 29 20 20 20 20 20 20 20 20 20 tatus!)
24c0: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 73 74 (apply db:testst
24d0: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
24e0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
24f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2500: 20 20 20 20 28 28 64 65 6c 65 74 65 2d 73 74 65 ((delete-ste
2510: 70 73 2d 66 6f 72 2d 74 65 73 74 21 29 20 20 20 ps-for-test!)
2520: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 64 (apply db:d
2530: 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d elete-steps-for-
2540: 74 65 73 74 21 20 64 62 73 74 72 75 63 74 20 70 test! dbstruct p
2550: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
2560: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2580: 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 20 ; TEST DATA.
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
25a0: 28 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 (test-data-rollu
25b0: 70 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 p) (
25c0: 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 64 61 apply db:test-da
25d0: 74 61 2d 72 6f 6c 6c 75 70 20 64 62 73 74 72 75 ta-rollup dbstru
25e0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2600: 28 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 29 (csv->test-data)
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2620: 61 70 70 6c 79 20 64 62 3a 63 73 76 2d 3e 74 65 apply db:csv->te
2630: 73 74 2d 64 61 74 61 20 64 62 73 74 72 75 63 74 st-data dbstruct
2640: 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 params))..
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2660: 20 4d 49 53 43 0a 20 20 20 20 20 20 20 20 20 20 MISC.
2670: 20 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 2d ((sync-
2680: 69 6e 6d 65 6d 2d 3e 64 62 29 20 20 20 20 20 20 inmem->db)
2690: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
26a0: 72 75 6e 2d 69 64 20 28 63 61 72 20 70 61 72 61 run-id (car para
26b0: 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ms))).
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e0: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 (db:s
26f0: 79 6e 63 2d 74 6f 75 63 68 65 64 20 64 62 73 74 ync-touched dbst
2700: 72 75 63 74 20 72 75 6e 2d 69 64 20 66 6f 72 63 ruct run-id forc
2710: 65 2d 73 79 6e 63 3a 20 23 74 29 29 29 0a 20 20 e-sync: #t))).
2720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2730: 20 28 28 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 ((mark-incomple
2740: 74 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 te)
2750: 20 28 61 70 70 6c 79 20 64 62 3a 66 69 6e 64 2d (apply db:find-
2760: 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
2770: 65 74 65 20 64 62 73 74 72 75 63 74 20 70 61 72 ete dbstruct par
2780: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2790: 20 20 20 20 20 20 20 20 20 28 28 63 72 65 61 74 ((creat
27a0: 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 20 e-all-triggers)
27b0: 20 20 20 20 20 20 20 20 20 28 64 62 3a 63 72 65 (db:cre
27c0: 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 ate-all-triggers
27d0: 20 64 62 73 74 72 75 63 74 29 29 0a 20 20 20 20 dbstruct)).
27e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
27f0: 28 64 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 (drop-all-trigge
2800: 72 73 29 20 20 20 20 20 20 20 20 20 20 20 20 28 rs) (
2810: 64 62 3a 64 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 db:drop-all-trig
2820: 67 65 72 73 20 64 62 73 74 72 75 63 74 29 29 20 gers dbstruct))
2830: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2840: 20 20 20 20 20 3b 3b 20 54 45 53 54 4d 45 54 41 ;; TESTMETA
2850: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2860: 20 20 20 20 28 28 74 65 73 74 6d 65 74 61 2d 61 ((testmeta-a
2870: 64 64 2d 72 65 63 6f 72 64 29 20 20 20 20 20 20 dd-record)
2880: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 6d (apply db:testm
2890: 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 64 eta-add-record d
28a0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
28b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
28c0: 20 20 20 20 28 28 74 65 73 74 6d 65 74 61 2d 75 ((testmeta-u
28d0: 70 64 61 74 65 2d 66 69 65 6c 64 29 20 20 20 20 pdate-field)
28e0: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 6d (apply db:testm
28f0: 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 eta-update-field
2900: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2910: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2920: 20 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 ((get-test
2930: 73 2d 74 61 67 73 29 20 20 20 20 20 20 20 20 20 s-tags)
2940: 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 (db:get-tests
2950: 2d 74 61 67 73 20 64 62 73 74 72 75 63 74 29 29 -tags dbstruct))
2960: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2970: 20 20 20 20 20 3b 3b 20 54 41 53 4b 53 0a 20 20 ;; TASKS.
2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2990: 20 28 28 74 61 73 6b 73 2d 61 64 64 29 20 20 20 ((tasks-add)
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
29b0: 70 70 6c 79 20 74 61 73 6b 73 3a 61 64 64 20 64 pply tasks:add d
29c0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
29d0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
29e0: 20 20 20 20 20 20 20 28 28 74 61 73 6b 73 2d 73 ((tasks-s
29f0: 65 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 et-state-given-p
2a00: 61 72 61 6d 2d 6b 65 79 29 20 28 61 70 70 6c 79 aram-key) (apply
2a10: 20 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 74 65 tasks:set-state
2a20: 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 -given-param-key
2a30: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2a40: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2a50: 20 20 20 20 20 20 28 28 74 61 73 6b 73 2d 67 65 ((tasks-ge
2a60: 74 2d 6c 61 73 74 29 20 20 20 20 20 20 20 20 20 t-last)
2a70: 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 3a (apply tasks:
2a80: 67 65 74 2d 6c 61 73 74 20 64 62 73 74 72 75 63 get-last dbstruc
2a90: 74 20 70 61 72 61 6d 73 29 29 0a 0a 09 09 20 20 t params))....
2aa0: 20 3b 3b 20 4e 4f 20 53 59 4e 43 20 44 42 0a 09 ;; NO SYNC DB..
2ab0: 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 73 65 . ((no-sync-se
2ac0: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t)
2ad0: 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 (apply db:no-sy
2ae0: 6e 63 2d 73 65 74 20 20 20 20 20 20 20 20 20 2a nc-set *
2af0: 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 61 no-sync-db* para
2b00: 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f 2d 73 ms))... ((no-s
2b10: 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 29 ync-get/default)
2b20: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2b30: 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 :no-sync-get/def
2b40: 61 75 6c 74 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 ault *no-sync-db
2b50: 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 * params))...
2b60: 28 28 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 29 20 ((no-sync-del!)
2b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2b80: 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 64 ply db:no-sync-d
2b90: 65 6c 21 20 20 20 20 20 20 20 20 2a 6e 6f 2d 73 el! *no-s
2ba0: 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 ync-db* params))
2bb0: 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d ... ((no-sync-
2bc0: 67 65 74 2d 6c 6f 63 6b 29 20 20 20 20 20 20 20 get-lock)
2bd0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d (apply db:no-
2be0: 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 20 20 sync-get-lock
2bf0: 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 *no-sync-db* pa
2c00: 72 61 6d 73 29 29 0a 09 09 20 20 20 0a 20 20 20 rams))... .
2c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c20: 3b 3b 20 41 52 43 48 49 56 45 53 0a 20 20 20 20 ;; ARCHIVES.
2c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2c40: 3b 20 28 28 61 72 63 68 69 76 65 2d 67 65 74 2d ; ((archive-get-
2c50: 61 6c 6c 6f 63 61 74 69 6f 6e 73 29 20 20 20 0a allocations) .
2c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c70: 20 20 20 28 28 61 72 63 68 69 76 65 2d 72 65 67 ((archive-reg
2c80: 69 73 74 65 72 2d 64 69 73 6b 29 20 20 20 20 20 ister-disk)
2c90: 28 61 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76 (apply db:archiv
2ca0: 65 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 20 e-register-disk
2cb0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2cc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2cd0: 20 20 20 20 20 28 28 61 72 63 68 69 76 65 2d 72 ((archive-r
2ce0: 65 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 egister-block-na
2cf0: 6d 65 29 28 61 70 70 6c 79 20 64 62 3a 61 72 63 me)(apply db:arc
2d00: 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c hive-register-bl
2d10: 6f 63 6b 2d 6e 61 6d 65 20 64 62 73 74 72 75 63 ock-name dbstruc
2d20: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2d40: 20 28 28 61 72 63 68 69 76 65 2d 61 6c 6c 6f 63 ((archive-alloc
2d50: 61 74 65 2d 74 65 73 74 73 75 69 74 65 2f 61 72 ate-testsuite/ar
2d60: 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29 28 61 70 70 ea-to-block)(app
2d70: 6c 79 20 64 62 3a 61 72 63 68 69 76 65 2d 61 6c ly db:archive-al
2d80: 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 65 locate-testsuite
2d90: 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 64 /area-to-block d
2da0: 62 73 74 72 75 63 74 20 62 6c 6f 63 6b 2d 69 64 bstruct block-id
2db0: 20 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 20 testsuite-name
2dc0: 61 72 65 61 6b 65 79 29 29 0a 0a 20 20 20 20 20 areakey))..
2dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e20: 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20 20 20 20 20 ======.
2e30: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 45 41 ;; REA
2e40: 44 20 4f 4e 4c 59 20 51 55 45 52 49 45 53 0a 20 D ONLY QUERIES.
2e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e60: 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 20 20 20 20 ==========..
2eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2ec0: 3b 20 4b 45 59 53 0a 20 20 20 20 20 20 20 20 20 ; KEYS.
2ed0: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
2ee0: 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 29 20 20 key-val-pairs)
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2f00: 70 6c 79 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 ply db:get-key-v
2f10: 61 6c 2d 70 61 69 72 73 20 64 62 73 74 72 75 63 al-pairs dbstruc
2f20: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2f40: 67 65 74 2d 6b 65 79 73 29 20 20 20 20 20 20 20 get-keys)
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (db:get-keys db
2f70: 73 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 struct)).
2f80: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
2f90: 74 2d 6b 65 79 2d 76 61 6c 73 29 20 20 20 20 20 t-key-vals)
2fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2fb0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6b 65 79 apply db:get-key
2fc0: 2d 76 61 6c 73 20 64 62 73 74 72 75 63 74 20 70 -vals dbstruct p
2fd0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
2fe0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
2ff0: 2d 74 61 72 67 65 74 29 20 20 20 20 20 20 20 20 -target)
3000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
3010: 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 61 72 67 pply db:get-targ
3020: 65 74 20 64 62 73 74 72 75 63 74 20 70 61 72 61 et dbstruct para
3030: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
3040: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74 61 ((get-ta
3050: 72 67 65 74 73 29 20 20 20 20 20 20 20 20 20 20 rgets)
3060: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 (db:g
3070: 65 74 2d 74 61 72 67 65 74 73 20 64 62 73 74 72 et-targets dbstr
3080: 75 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 20 uct))..
3090: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 41 52 43 ;; ARC
30a0: 48 49 56 45 53 0a 20 20 20 20 20 20 20 20 20 20 HIVES.
30b0: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d ((test-
30c0: 67 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 get-archive-bloc
30d0: 6b 2d 69 6e 66 6f 29 20 20 20 20 20 28 61 70 70 k-info) (app
30e0: 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 61 ly db:test-get-a
30f0: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 rchive-block-inf
3100: 6f 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d o dbstruct param
3110: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3120: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
3130: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
3140: 53 54 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 STS.
3150: 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 74 6f ((test-to
3160: 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 plevel-num-items
3170: 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 ) (apply
3180: 20 64 62 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 db:test-topleve
3190: 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20 64 62 73 74 l-num-items 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 74 65 73 74 2d 69 6e 66 6f ((get-test-info
31d0: 2d 62 79 2d 69 64 29 09 20 20 20 20 20 20 20 28 -by-id). (
31e0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 apply db:get-tes
31f0: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 t-info-by-id dbs
3200: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3220: 20 20 28 28 74 65 73 74 2d 67 65 74 2d 72 75 6e ((test-get-run
3230: 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 dir-from-test-id
3240: 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 ) (apply db:t
3250: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 est-get-rundir-f
3260: 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 73 74 rom-test-id dbst
3270: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3290: 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 ((get-count-tes
32a0: 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 ts-running-for-t
32b0: 65 73 74 6e 61 6d 65 29 20 28 61 70 70 6c 79 20 estname) (apply
32c0: 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 db:get-count-tes
32d0: 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 ts-running-for-t
32e0: 65 73 74 6e 61 6d 65 20 64 62 73 74 72 75 63 74 estname dbstruct
32f0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3300: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
3310: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
3320: 75 6e 6e 69 6e 67 29 20 20 20 20 20 20 20 20 20 unning)
3330: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f (apply db:get-co
3340: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
3350: 67 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d g dbstruct param
3360: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3370: 20 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 ((get-cou
3380: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
3390: 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 29 20 28 61 -in-jobgroup) (a
33a0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e pply db:get-coun
33b0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
33c0: 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 64 62 73 74 in-jobgroup dbst
33d0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
33e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33f0: 20 3b 3b 20 28 28 64 65 6c 65 74 65 2d 74 65 73 ;; ((delete-tes
3400: 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 29 20 t-step-records)
3410: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3420: 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 :delete-test-ste
3430: 70 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 p-records dbstru
3440: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
3460: 3b 20 28 28 67 65 74 2d 70 72 65 76 69 6f 75 73 ; ((get-previous
3470: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
3480: 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 ) (apply db:g
3490: 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 et-previous-test
34a0: 2d 72 75 6e 2d 72 65 63 6f 72 64 20 64 62 73 74 -run-record dbst
34b0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 28 28 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d ((get-matching-
34e0: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
34f0: 6e 2d 72 65 63 6f 72 64 73 29 28 61 70 70 6c 79 n-records)(apply
3500: 20 64 62 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 db:get-matching
3510: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
3520: 75 6e 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 un-records dbstr
3530: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3550: 28 28 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 ((test-get-logfi
3560: 6c 65 2d 69 6e 66 6f 29 20 20 20 20 20 20 20 20 le-info)
3570: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
3580: 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e t-get-logfile-in
3590: 66 6f 20 64 62 73 74 72 75 63 74 20 70 61 72 61 fo dbstruct para
35a0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
35b0: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 ((test-g
35c0: 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 et-records-for-i
35d0: 6e 64 65 78 2d 66 69 6c 65 29 20 20 28 61 70 70 ndex-file) (app
35e0: 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ly db:test-get-r
35f0: 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 ecords-for-index
3600: 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 20 70 -file dbstruct p
3610: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3620: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3630: 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d -testinfo-state-
3640: 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 61 status) (a
3650: 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 pply db:get-test
3660: 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 info-state-statu
3670: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3680: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3690: 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 ((test-ge
36a0: 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 t-top-process-pi
36b0: 64 29 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 d) (apply
36c0: 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 db:test-get-top
36d0: 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 64 62 73 -process-pid dbs
36e0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
36f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3700: 20 20 28 28 74 65 73 74 2d 67 65 74 2d 70 61 74 ((test-get-pat
3710: 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e hs-matching-keyn
3720: 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 29 ames-target-new)
3730: 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d (apply db:test-
3740: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
3750: 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 ng-keynames-targ
3760: 65 74 2d 6e 65 77 20 64 62 73 74 72 75 63 74 20 et-new dbstruct
3770: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3780: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 ((ge
3790: 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 t-prereqs-not-me
37a0: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 t) (
37b0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 65 apply db:get-pre
37c0: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 64 62 73 reqs-not-met dbs
37d0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37f0: 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 ((get-count-te
3800: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
3810: 72 75 6e 2d 69 64 29 20 28 61 70 70 6c 79 20 64 run-id) (apply d
3820: 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 b:get-count-test
3830: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 s-running-for-ru
3840: 6e 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 n-id dbstruct pa
3850: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3860: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3870: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e not-completed-cn
3880: 74 29 20 20 20 20 20 20 20 20 20 20 20 28 61 70 t) (ap
3890: 70 6c 79 20 64 62 3a 67 65 74 2d 6e 6f 74 2d 63 ply db:get-not-c
38a0: 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 20 20 64 62 ompleted-cnt db
38b0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 struct params))
38c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
38d0: 20 20 20 20 3b 3b 20 28 28 73 79 6e 63 68 61 73 ;; ((synchas
38e0: 68 2d 67 65 74 29 20 20 20 20 20 20 20 20 20 20 h-get)
38f0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
3900: 20 73 79 6e 63 68 61 73 68 3a 73 65 72 76 65 72 synchash:server
3910: 2d 67 65 74 20 64 62 73 74 72 75 63 74 20 70 61 -get dbstruct pa
3920: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3930: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3940: 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 raw-run-stats)
3950: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3960: 70 6c 79 20 64 62 3a 67 65 74 2d 72 61 77 2d 72 ply db:get-raw-r
3970: 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 un-stats dbstruc
3980: 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 t params))...
3990: 28 28 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 ((get-test-times
39a0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
39b0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
39c0: 2d 74 65 73 74 2d 74 69 6d 65 73 20 64 62 73 74 -test-times dbst
39d0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 ruct params))..
39e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39f0: 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 20 20 ;; RUNS.
3a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 ((g
3a10: 65 74 2d 72 75 6e 2d 69 6e 66 6f 29 20 20 20 20 et-run-info)
3a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3a30: 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 69 ply db:get-run-i
3a40: 6e 66 6f 20 64 62 73 74 72 75 63 74 20 70 61 72 nfo dbstruct par
3a50: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
3a60: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
3a70: 75 6e 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 un-status)
3a80: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3a90: 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 db:get-run-statu
3aa0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3ab0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3ac0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e ((get-run
3ad0: 2d 73 74 61 74 65 29 20 20 20 20 20 20 20 20 20 -state)
3ae0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3af0: 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 20 64 :get-run-state d
3b00: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3b10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3b20: 20 20 20 20 28 28 73 65 74 2d 72 75 6e 2d 73 74 ((set-run-st
3b30: 61 74 75 73 29 20 20 20 20 20 20 20 20 20 20 20 atus)
3b40: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 (apply db:se
3b50: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 64 62 73 t-run-status dbs
3b60: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 28 28 73 65 74 2d 72 75 6e 2d 73 74 61 74 ((set-run-stat
3b90: 65 2d 73 74 61 74 75 73 29 20 20 09 09 09 20 28 e-status) ... (
3ba0: 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 72 75 6e apply db:set-run
3bb0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 -state-status db
3bc0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3be0: 20 20 20 28 28 75 70 64 61 74 65 2d 74 65 73 64 ((update-tesd
3bf0: 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 ata-on-repilcate
3c00: 2d 64 62 29 20 28 61 70 70 6c 79 20 64 62 3a 75 -db) (apply db:u
3c10: 70 64 61 74 65 2d 74 65 73 64 61 74 61 2d 6f 6e pdate-tesdata-on
3c20: 2d 72 65 70 69 6c 63 61 74 65 2d 64 62 20 20 64 -repilcate-db d
3c30: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3c40: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3c50: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 73 ((get-tests
3c60: 2d 66 6f 72 2d 72 75 6e 29 20 20 20 20 20 20 20 -for-run)
3c70: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
3c80: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
3c90: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3ca0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3cb0: 20 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 ((get-test
3cc0: 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d s-for-run-state-
3cd0: 73 74 61 74 75 73 29 20 28 61 70 70 6c 79 20 64 status) (apply d
3ce0: 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d b:get-tests-for-
3cf0: 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 run-state-status
3d00: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3d20: 20 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 ((get-test
3d30: 2d 69 64 29 20 20 20 20 20 20 20 20 20 20 20 20 -id)
3d40: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3d50: 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 73 74 get-test-id dbst
3d60: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d80: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 ((get-tests-for
3d90: 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 29 20 20 20 -run-mindata)
3da0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3db0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e ests-for-run-min
3dc0: 64 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 data dbstruct pa
3dd0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3de0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 67 ;; ((g
3df0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
3e00: 73 2d 6d 69 6e 64 61 74 61 29 20 20 20 28 61 70 s-mindata) (ap
3e10: 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 ply db:get-tests
3e20: 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 -for-runs-mindat
3e30: 61 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d a dbstruct param
3e40: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3e50: 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e ((get-run
3e60: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s)
3e70: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3e80: 3a 67 65 74 2d 72 75 6e 73 20 64 62 73 74 72 75 :get-runs dbstru
3e90: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3eb0: 28 73 69 6d 70 6c 65 2d 67 65 74 2d 72 75 6e 73 (simple-get-runs
3ec0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ) (
3ed0: 61 70 70 6c 79 20 64 62 3a 73 69 6d 70 6c 65 2d apply db:simple-
3ee0: 67 65 74 2d 72 75 6e 73 20 64 62 73 74 72 75 63 get-runs dbstruc
3ef0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3f10: 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 29 20 20 20 get-num-runs)
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
3f30: 70 70 6c 79 20 64 62 3a 67 65 74 2d 6e 75 6d 2d pply db:get-num-
3f40: 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 70 61 runs dbstruct pa
3f50: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3f60: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3f70: 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 runs-cnt-by-patt
3f80: 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 ) (apply
3f90: 20 64 62 3a 67 65 74 2d 72 75 6e 73 2d 63 6e 74 db:get-runs-cnt
3fa0: 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 -by-patt dbstruc
3fb0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3fd0: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 get-all-run-ids)
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
3ff0: 62 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 b:get-all-run-id
4000: 73 20 64 62 73 74 72 75 63 74 29 29 0a 20 20 20 s dbstruct)).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4020: 28 28 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d 69 ((get-prev-run-i
4030: 64 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ds)
4040: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 (apply db:get-pr
4050: 65 76 2d 72 75 6e 2d 69 64 73 20 64 62 73 74 72 ev-run-ids dbstr
4060: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
4070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4080: 28 28 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 ((get-run-ids-ma
4090: 74 63 68 69 6e 67 2d 74 61 72 67 65 74 29 20 20 tching-target)
40a0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 (apply db:get-ru
40b0: 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 n-ids-matching-t
40c0: 61 72 67 65 74 20 64 62 73 74 72 75 63 74 20 70 arget dbstruct p
40d0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
40e0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
40f0: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 29 20 20 -runs-by-patt)
4100: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
4110: 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 y db:get-runs-by
4120: 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 20 70 -patt dbstruct p
4130: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
4140: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
4150: 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 -run-name-from-i
4160: 64 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c d) (appl
4170: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 6e 61 6d y db:get-run-nam
4180: 65 2d 66 72 6f 6d 2d 69 64 20 64 62 73 74 72 75 e-from-id dbstru
4190: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
41a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
41b0: 28 67 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 (get-main-run-st
41c0: 61 74 73 29 20 20 20 20 20 20 20 20 20 20 20 28 ats) (
41d0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6d 61 69 apply db:get-mai
41e0: 6e 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 n-run-stats dbst
41f0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4210: 20 28 28 67 65 74 2d 76 61 72 29 20 20 20 20 20 ((get-var)
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 76 (apply db:get-v
4240: 61 72 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ar dbstruct para
4250: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
4260: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 ((get-ru
4270: 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 20 n-stats)
4280: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
4290: 62 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 20 b:get-run-stats
42a0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
42b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
42c0: 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 74 ((get-run-t
42d0: 69 6d 65 73 29 20 20 20 20 20 20 20 20 20 20 20 imes)
42e0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
42f0: 65 74 2d 72 75 6e 2d 74 69 6d 65 73 20 64 62 73 et-run-times dbs
4300: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a truct params)) .
4310: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4320: 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 ;; STEPS.
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 28 28 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 ((get-steps-data
4350: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4360: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 (apply db:get-st
4370: 65 70 73 2d 64 61 74 61 20 64 62 73 74 72 75 63 eps-data dbstruc
4380: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
43a0: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
43b0: 73 74 29 20 20 20 20 20 20 20 20 20 20 20 28 61 st) (a
43c0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 65 70 pply db:get-step
43d0: 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 73 74 72 s-for-test dbstr
43e0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 uct params))...
43f0: 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d 69 6e ((get-steps-in
4400: 66 6f 2d 62 79 2d 69 64 29 20 20 20 20 20 20 20 fo-by-id)
4410: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
4420: 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 steps-info-by-id
4430: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
4440: 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))..
4450: 20 20 20 20 20 20 20 3b 3b 20 54 45 53 54 20 44 ;; TEST D
4460: 41 54 41 0a 20 20 20 20 20 20 20 20 20 20 20 20 ATA.
4470: 20 20 20 20 20 20 20 28 28 72 65 61 64 2d 74 65 ((read-te
4480: 73 74 2d 64 61 74 61 29 20 20 20 20 20 20 20 20 st-data)
4490: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
44a0: 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 :read-test-data
44b0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
44c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
44d0: 20 20 20 20 20 28 28 72 65 61 64 2d 74 65 73 74 ((read-test
44e0: 2d 64 61 74 61 2d 76 61 72 70 61 74 74 29 20 20 -data-varpatt)
44f0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 72 (apply db:r
4500: 65 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 61 ead-test-data-va
4510: 72 70 61 74 74 20 64 62 73 74 72 75 63 74 20 70 rpatt dbstruct p
4520: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
4530: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
4540: 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 -data-info-by-id
4550: 29 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c ) (appl
4560: 79 20 64 62 3a 67 65 74 2d 64 61 74 61 2d 69 6e y db:get-data-in
4570: 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 72 75 63 fo-by-id dbstruc
4580: 74 20 70 61 72 61 6d 73 29 29 20 0a 0a 20 20 20 t params)) ..
4590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45a0: 3b 3b 20 4d 49 53 43 0a 20 20 20 20 20 20 20 20 ;; MISC.
45b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
45c0: 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 -latest-host-loa
45d0: 64 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c d) (appl
45e0: 79 20 64 62 3a 67 65 74 2d 6c 61 74 65 73 74 2d y db:get-latest-
45f0: 68 6f 73 74 2d 6c 6f 61 64 20 64 62 73 74 72 75 host-load dbstru
4600: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4620: 28 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 (have-incomplete
4630: 73 3f 29 20 20 20 20 20 20 20 20 20 20 20 20 28 s?) (
4640: 61 70 70 6c 79 20 64 62 3a 68 61 76 65 2d 69 6e apply db:have-in
4650: 63 6f 6d 70 6c 65 74 65 73 3f 20 64 62 73 74 72 completes? dbstr
4660: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4680: 28 28 6c 6f 67 69 6e 29 20 20 20 20 20 20 20 20 ((login)
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46a0: 28 61 70 70 6c 79 20 64 62 3a 6c 6f 67 69 6e 20 (apply db:login
46b0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
46c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
46d0: 20 20 20 20 20 28 28 67 65 6e 65 72 61 6c 2d 63 ((general-c
46e0: 61 6c 6c 29 20 20 20 20 20 20 20 20 20 20 20 20 all)
46f0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 6d 74 (let ((stmt
4700: 6e 61 6d 65 20 20 20 28 63 61 72 20 70 61 72 61 name (car para
4710: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
4720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
4750: 75 6e 2d 69 64 20 20 20 20 20 28 63 61 64 72 20 un-id (cadr
4760: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
4770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47a0: 20 20 28 72 65 61 6c 70 61 72 61 6d 73 20 28 63 (realparams (c
47b0: 64 64 72 20 70 61 72 61 6d 73 29 29 29 0a 20 20 ddr params))).
47c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47f0: 20 20 20 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 (db:general-c
4800: 61 6c 6c 20 64 62 73 74 72 75 63 74 20 73 74 6d all dbstruct stm
4810: 74 6e 61 6d 65 20 72 65 61 6c 70 61 72 61 6d 73 tname realparams
4820: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
4830: 20 20 20 20 20 20 20 28 28 73 64 62 2d 71 72 79 ((sdb-qry
4840: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4850: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 73 64 (apply sd
4860: 62 3a 71 72 79 20 70 61 72 61 6d 73 29 29 0a 20 b:qry params)).
4870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4880: 20 20 28 28 70 69 6e 67 29 20 20 20 20 20 20 20 ((ping)
4890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48a0: 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 (current-proce
48b0: 73 73 2d 69 64 29 29 0a 09 09 20 20 20 28 28 67 ss-id))... ((g
48c0: 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 et-changed-recor
48d0: 64 2d 69 64 73 29 20 20 20 20 20 20 20 28 61 70 d-ids) (ap
48e0: 70 6c 79 20 64 62 3a 67 65 74 2d 63 68 61 6e 67 ply db:get-chang
48f0: 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 64 62 ed-record-ids db
4900: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
4910: 09 09 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 72 .. ((get-run-r
4920: 65 63 6f 72 64 2d 69 64 73 29 20 09 20 20 20 28 ecord-ids) . (
4930: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
4940: 2d 72 65 63 6f 72 64 2d 69 64 73 20 64 62 73 74 -record-ids dbst
4950: 72 75 63 74 20 70 61 72 61 6d 73 29 29 09 0a 20 ruct params))..
4960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4970: 20 20 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 ;; TESTMETA.
4980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4990: 20 28 28 74 65 73 74 6d 65 74 61 2d 67 65 74 2d ((testmeta-get-
49a0: 72 65 63 6f 72 64 29 20 20 20 20 20 20 20 28 61 record) (a
49b0: 70 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 pply db:testmeta
49c0: 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 73 74 -get-record dbst
49d0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 ruct params))..
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 3b 3b 20 54 41 53 4b 53 20 0a 20 20 20 20 ;; TASKS .
4a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4a10: 28 66 69 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 (find-task-queue
4a20: 2d 72 65 63 6f 72 64 73 29 20 20 20 28 61 70 70 -records) (app
4a30: 6c 79 20 74 61 73 6b 73 3a 66 69 6e 64 2d 74 61 ly tasks:find-ta
4a40: 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 sk-queue-records
4a50: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
4a60: 29 29 0a 09 09 20 20 20 28 65 6c 73 65 0a 09 09 ))... (else...
4a70: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4a80: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4a90: 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 62 61 port* "ERROR: ba
4aa0: 64 20 61 70 69 20 63 61 6c 6c 20 22 20 63 6d 64 d api call " cmd
4ab0: 29 0a 09 09 20 20 20 20 28 63 6f 6e 63 20 22 45 )... (conc "E
4ac0: 52 52 4f 52 3a 20 42 41 44 20 61 70 69 20 63 61 RROR: BAD api ca
4ad0: 6c 6c 20 22 20 63 6d 64 29 29 29 29 29 29 0a 0a ll " cmd))))))..
4ae0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 3b . ;
4af0: 3b 20 73 61 76 65 20 61 6c 6c 20 73 74 61 74 73 ; save all stats
4b00: 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 . (let ((d
4b10: 65 6c 74 61 2d 74 20 28 2d 20 28 63 75 72 72 65 elta-t (- (curre
4b20: 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 nt-milliseconds)
4b30: 0a 09 09 09 20 73 74 61 72 74 2d 74 29 29 29 0a .... start-t))).
4b40: 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 . (hash-table-se
4b50: 74 21 20 2a 64 62 2d 61 70 69 2d 63 61 6c 6c 2d t! *db-api-call-
4b60: 74 69 6d 65 2a 20 63 6d 64 0a 09 09 09 20 20 28 time* cmd.... (
4b70: 63 6f 6e 73 20 64 65 6c 74 61 2d 74 20 28 68 61 cons delta-t (ha
4b80: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
4b90: 61 75 6c 74 20 2a 64 62 2d 61 70 69 2d 63 61 6c ault *db-api-cal
4ba0: 6c 2d 74 69 6d 65 2a 20 63 6d 64 20 27 28 29 29 l-time* cmd '())
4bb0: 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 77 ))). (if w
4bc0: 72 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f ritecmd-in-reado
4bd0: 6e 6c 79 2d 6d 6f 64 65 0a 20 20 20 20 20 20 20 nly-mode.
4be0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
4bf0: 20 20 20 20 20 20 20 20 23 3b 28 63 6f 6d 6d 6f #;(commo
4c00: 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 n:telemetry-log
4c10: 28 63 6f 6e 63 20 22 61 70 69 2d 6f 75 74 3a 22 (conc "api-out:"
4c20: 28 2d 3e 73 74 72 69 6e 67 20 63 6d 64 29 29 0a (->string cmd)).
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 20 20 70 61 79 6c 6f 61 64 3a 20 60 28 28 70 payload: `((p
4c60: 61 72 61 6d 73 20 2e 20 2c 70 61 72 61 6d 73 29 arams . ,params)
4c70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4ca0: 6f 6b 2d 72 65 73 20 2e 20 23 74 29 29 29 0a 09 ok-res . #t)))..
4cb0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 (vector #f
4cc0: 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 res)).
4cd0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
4ce0: 20 20 20 20 20 23 3b 28 63 6f 6d 6d 6f 6e 3a 74 #;(common:t
4cf0: 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 28 63 6f elemetry-log (co
4d00: 6e 63 20 22 61 70 69 2d 6f 75 74 3a 22 28 2d 3e nc "api-out:"(->
4d10: 73 74 72 69 6e 67 20 63 6d 64 29 29 0a 20 20 20 string cmd)).
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d40: 70 61 79 6c 6f 61 64 3a 20 60 28 28 70 61 72 61 payload: `((para
4d50: 6d 73 20 2e 20 2c 70 61 72 61 6d 73 29 0a 20 20 ms . ,params).
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 6b 2d (ok-
4d90: 72 65 73 20 2e 20 23 66 29 29 29 0a 20 20 20 20 res . #f))).
4da0: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
4db0: 20 23 74 20 72 65 73 29 29 29 29 29 29 29 29 0a #t res)))))))).
4dc0: 0a 3b 3b 20 68 74 74 70 2d 73 65 72 76 65 72 20 .;; http-server
4dd0: 20 73 65 6e 64 2d 72 65 73 70 6f 6e 73 65 0a 3b send-response.;
4de0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
4df0: 20 20 61 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 api:process-re
4e00: 71 75 65 73 74 0a 3b 3b 20 20 20 20 20 20 20 20 quest.;;
4e10: 20 20 20 20 20 20 20 20 20 20 20 20 64 62 3a 2a db:*
4e20: 0a 3b 3b 0a 3b 3b 20 4e 42 2f 2f 20 52 75 6e 73 .;;.;; NB// Runs
4e30: 20 6f 6e 20 74 68 65 20 73 65 72 76 65 72 20 61 on the server a
4e40: 73 20 70 61 72 74 20 6f 66 20 74 68 65 20 73 65 s part of the se
4e50: 72 76 65 72 20 6c 6f 6f 70 0a 3b 3b 0a 28 64 65 rver loop.;;.(de
4e60: 66 69 6e 65 20 28 61 70 69 3a 70 72 6f 63 65 73 fine (api:proces
4e70: 73 2d 72 65 71 75 65 73 74 20 64 62 73 74 72 75 s-request dbstru
4e80: 63 74 20 24 29 20 3b 3b 20 74 68 65 20 24 20 69 ct $) ;; the $ i
4e90: 73 20 74 68 65 20 72 65 71 75 65 73 74 20 76 61 s the request va
4ea0: 72 73 20 70 72 6f 63 0a 20 20 28 64 65 62 75 67 rs proc. (debug
4eb0: 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c :print 4 *defaul
4ec0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 72 t-log-port* "ser
4ed0: 76 65 72 2d 69 64 3a 22 20 20 2a 73 65 72 76 65 ver-id:" *serve
4ee0: 72 2d 69 64 2a 29 0a 20 20 28 6c 65 74 2a 20 28 r-id*). (let* (
4ef0: 28 63 6d 64 20 20 20 20 20 28 24 20 27 63 6d 64 (cmd ($ 'cmd
4f00: 29 29 0a 09 20 28 70 61 72 61 6d 73 6a 20 28 24 )).. (paramsj ($
4f10: 20 27 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 'params)).
4f20: 20 20 20 20 28 6b 65 79 20 20 20 20 20 28 24 20 (key ($
4f30: 27 6b 65 79 29 29 20 20 20 0a 09 20 28 70 61 72 'key)) .. (par
4f40: 61 6d 73 20 20 28 64 62 3a 73 74 72 69 6e 67 2d ams (db:string-
4f50: 3e 6f 62 6a 20 70 61 72 61 6d 73 6a 20 74 72 61 >obj paramsj tra
4f60: 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 29 29 nsport: 'http)))
4f70: 20 3b 3b 20 69 6e 63 6f 6d 69 6e 67 20 64 61 74 ;; incoming dat
4f80: 61 20 66 72 6f 6d 20 74 68 65 20 50 4f 53 54 20 a from the POST
4f90: 28 6f 72 20 69 73 20 69 74 20 61 20 47 45 54 3f (or is it a GET?
4fa0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
4fb0: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
4fc0: 67 2d 70 6f 72 74 2a 20 22 63 6d 64 3a 22 20 63 g-port* "cmd:" c
4fd0: 6d 64 20 22 20 77 69 74 68 20 70 61 72 61 6d 73 md " with params
4fe0: 20 22 20 70 61 72 61 6d 73 20 22 6b 65 79 20 22 " params "key "
4ff0: 20 6b 65 79 29 0a 20 20 20 20 28 69 66 20 28 65 key). (if (e
5000: 71 75 61 6c 3f 20 6b 65 79 20 2a 73 65 72 76 65 qual? key *serve
5010: 72 2d 69 64 2a 29 0a 20 20 20 20 20 20 28 62 65 r-id*). (be
5020: 67 69 6e 0a 20 20 20 20 20 20 20 20 28 73 65 74 gin. (set
5030: 21 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 ! *api-process-r
5040: 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 28 2b equest-count* (+
5050: 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 *api-process-re
5060: 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 31 29 29 quest-count* 1))
5070: 0a 20 09 28 6c 65 74 2a 20 28 28 72 65 73 64 61 . .(let* ((resda
5080: 74 20 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d t (api:execute-
5090: 72 65 71 75 65 73 74 73 20 64 62 73 74 72 75 63 requests dbstruc
50a0: 74 20 28 76 65 63 74 6f 72 20 63 6d 64 20 70 61 t (vector cmd pa
50b0: 72 61 6d 73 29 29 29 20 3b 3b 20 70 72 6f 63 65 rams))) ;; proce
50c0: 73 73 20 74 68 65 20 72 65 71 75 65 73 74 2c 20 ss the request,
50d0: 72 65 73 64 61 74 20 3d 20 23 28 20 66 6c 61 67 resdat = #( flag
50e0: 20 72 65 73 75 6c 74 20 29 0a 09 20 20 20 20 20 result )..
50f0: 20 20 28 73 75 63 63 65 73 73 20 28 76 65 63 74 (success (vect
5100: 6f 72 2d 72 65 66 20 72 65 73 64 61 74 20 30 29 or-ref resdat 0)
5110: 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 20 ).. (res
5120: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
5130: 65 73 64 61 74 20 31 29 29 29 20 3b 3b 20 28 76 esdat 1))) ;; (v
5140: 65 63 74 6f 72 20 66 6c 61 67 20 70 61 79 6c 6f ector flag paylo
5150: 61 64 29 2c 20 67 65 74 20 74 68 65 20 70 61 79 ad), get the pay
5160: 6c 6f 61 64 2c 20 69 67 6e 6f 72 65 20 74 68 65 load, ignore the
5170: 20 66 6c 61 67 20 28 77 68 79 3f 29 0a 09 20 20 flag (why?)..
5180: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a (debug:print 4 *
5190: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
51a0: 2a 20 22 72 65 73 3a 22 20 72 65 73 29 0a 09 20 * "res:" res)..
51b0: 20 28 69 66 20 28 6e 6f 74 20 73 75 63 63 65 73 (if (not succes
51c0: 73 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 s).. (debug
51d0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
51e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 t-log-port* "ERR
51f0: 4f 52 3a 20 73 75 63 63 65 73 73 20 66 6c 61 67 OR: success flag
5200: 20 69 73 20 23 66 20 66 6f 72 20 22 20 63 6d 64 is #f for " cmd
5210: 20 22 20 77 69 74 68 20 70 61 72 61 6d 73 20 22 " with params "
5220: 20 70 61 72 61 6d 73 29 29 0a 09 20 20 28 69 66 params)).. (if
5230: 20 28 3e 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 (> *api-process
5240: 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 -request-count*
5250: 2a 6d 61 78 2d 61 70 69 2d 70 72 6f 63 65 73 73 *max-api-process
5260: 2d 72 65 71 75 65 73 74 73 2a 29 0a 09 20 20 20 -requests*)..
5270: 20 20 20 28 73 65 74 21 20 2a 6d 61 78 2d 61 70 (set! *max-ap
5280: 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 i-process-reques
5290: 74 73 2a 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 ts* *api-process
52a0: 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 29 -request-count*)
52b0: 29 0a 09 20 20 28 73 65 74 21 20 2a 61 70 69 2d ).. (set! *api-
52c0: 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d process-request-
52d0: 63 6f 75 6e 74 2a 20 28 2d 20 2a 61 70 69 2d 70 count* (- *api-p
52e0: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
52f0: 6f 75 6e 74 2a 20 31 29 29 0a 09 20 20 3b 3b 20 ount* 1)).. ;;
5300: 54 68 69 73 20 63 61 6e 20 62 65 20 68 65 72 65 This can be here
5310: 20 62 75 74 20 6e 65 65 64 73 20 63 6f 6e 74 72 but needs contr
5320: 6f 6c 73 20 74 6f 20 65 6e 73 75 72 65 20 69 74 ols to ensure it
5330: 20 64 6f 65 73 6e 27 74 20 72 75 6e 20 6d 6f 72 doesn't run mor
5340: 65 20 74 68 61 6e 20 65 76 65 72 79 20 34 20 73 e than every 4 s
5350: 65 63 6f 6e 64 73 0a 09 20 20 3b 3b 20 28 72 6d econds.. ;; (rm
5360: 74 3a 64 61 74 2d 3e 6a 73 6f 6e 2d 73 74 72 0a t:dat->json-str.
5370: 09 20 20 3b 3b 20 20 28 69 66 20 28 6f 72 20 28 . ;; (if (or (
5380: 73 74 72 69 6e 67 3f 20 72 65 73 29 0a 09 20 20 string? res)..
5390: 3b 3b 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 ;; (lis
53a0: 74 3f 20 20 20 72 65 73 29 0a 09 20 20 3b 3b 20 t? res).. ;;
53b0: 20 20 20 20 20 20 20 20 20 28 6e 75 6d 62 65 72 (number
53c0: 3f 20 72 65 73 29 0a 09 20 20 3b 3b 20 20 20 20 ? res).. ;;
53d0: 20 20 20 20 20 20 28 62 6f 6f 6c 65 61 6e 3f 20 (boolean?
53e0: 72 65 73 29 29 0a 09 20 20 3b 3b 20 20 20 20 20 res)).. ;;
53f0: 20 72 65 73 20 0a 09 20 20 3b 3b 20 20 20 20 20 res .. ;;
5400: 20 28 6c 69 73 74 20 22 45 52 52 4f 52 2c 20 6e (list "ERROR, n
5410: 6f 74 20 73 74 72 69 6e 67 2c 20 6c 69 73 74 2c ot string, list,
5420: 20 6e 75 6d 62 65 72 20 6f 72 20 62 6f 6f 6c 65 number or boole
5430: 61 6e 22 20 31 20 63 6d 64 20 70 61 72 61 6d 73 an" 1 cmd params
5440: 20 72 65 73 29 29 29 29 29 0a 09 20 20 28 64 62 res))))).. (db
5450: 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 72 65 73 :obj->string res
5460: 20 74 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 transport: 'htt
5470: 70 29 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 p)))..(begin..
5480: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
5490: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
54a0: 2a 20 20 20 22 53 65 72 76 65 72 20 72 65 66 75 * "Server refu
54b0: 73 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 72 sed to process r
54c0: 65 71 75 65 73 74 2e 20 53 65 76 65 72 20 69 64 equest. Sever id
54d0: 20 6d 69 73 6d 61 74 63 68 2e 20 72 65 63 69 76 mismatch. reciv
54e0: 65 64 20 22 20 6b 65 79 20 22 20 65 78 70 65 63 ed " key " expec
54f0: 74 65 64 3a 20 20 22 20 2a 73 65 72 76 65 72 2d ted: " *server-
5500: 69 64 2a 20 22 2e 5c 6e 4f 74 68 65 72 20 61 72 id* ".\nOther ar
5510: 67 75 6d 65 6e 74 73 20 72 65 63 69 76 65 64 3a guments recived:
5520: 20 63 6d 64 3d 22 20 63 6d 64 20 22 20 70 61 72 cmd=" cmd " par
5530: 61 6d 73 20 3d 20 22 20 70 61 72 61 6d 73 29 20 ams = " params)
5540: 0a 09 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 .. (db:obj->str
5550: 69 6e 67 20 28 63 6f 6e 63 20 22 53 65 72 76 65 ing (conc "Serve
5560: 72 20 72 65 66 75 73 65 64 20 74 6f 20 70 72 6f r refused to pro
5570: 63 65 73 73 20 72 65 71 75 65 73 74 20 73 65 72 cess request ser
5580: 76 65 72 2d 69 64 20 6d 69 73 6d 61 74 63 68 3a ver-id mismatch:
5590: 20 22 20 6b 65 79 20 22 2c 20 22 20 2a 73 65 72 " key ", " *ser
55a0: 76 65 72 2d 69 64 2a 29 20 74 72 61 6e 73 70 6f ver-id*) transpo
55b0: 72 74 3a 20 27 68 74 74 70 29 29 29 29 29 0a 0a rt: 'http)))))..
55c0: 29 0a ).